AutoCAD to CITYGML

Hi All,

CITYGML is the concept of publish the 3d Data on to the web.
we have written a AutoLISP program to convert the AutoCAD data to CITYGML format.
Inputs required for this tool.
Closed 3d polylines. with elevations updated.
Here is the code...
(Defun c:CityGML () (vl-load-com) (setq selset (ssget (list (cons 0 "polyline")))) (if selset (progn (setq xmlpath (strcat (getvar "dwgprefix") (vl-filename-base (getvar "Dwgname")) ".xml")) (setq xmlfile (open xmlpath "w"))
(write-line (Strcat "") xmlfile)
(write-line (strcat "http://www.citygml.org/citygml/1/0/0" (chr 34) " xmlns:gml=" (chr 34) "http://www.opengis.net/gml" (chr 34) " xmlns:xlink=" (chr 34) "http://www.w3.org/1999/xlink" (chr 34) " xmlns:xsi=" (chr 34) "http://www.w3.org/2001/XMLSchema-instance" (chr 34) " xsi:schemaLocation=" (chr 34) "http://www.citygml.org/citygml/1/0/0 http://www.citygml.org/citygml/1/0/0/CityGML.xsd" (chr 34) ">") xmlfile) (write-line "City Exporeted by Infotech" xmlfile)
(setq count 0) (setq setlen (sslength selset)) (while (<>\n \n \n \n \n ") xmlfile) (foreach extval extlist (CityGML_Write_Func xmlfile extval) ) (write-line (Strcat " \n \n \n \n \n ") xmlfile) ) ) (setq count (1+ count)) ) (write-line "" xmlfile) (close xmlfile) ) ))
;;; ! *************************************************************************************************************************************************************************
(defun CityGML_Write_Func (xmlfile lstvals )
(write-line (strcat " \n \n \n \n ") xmlfile)
(setq prntvals (mapcar '(lambda(x) (mapcar '(lambda (y) (rtos y)) x)) lstvals)) (setq retvals (INFO-LIST->STRING (mapcar '(lambda (x) (INFO-LIST->STRING x " ")) prntvals) " "))
(write-line (strcat "\n " retvals "") xmlfile)
(write-line "\n \n \n \n \n " xmlfile) )
;;; ! *************************************************************************************************************************************************************************



;;; ! *************************************************************************************************************************************************************************
(defun Genrate_Extrude (Ent) (setq retlist '()) (setq ptlist (Info-GetVertices Ent))
(command "pline" ) (apply 'command ptlist) (command "c") (setq lent (entlast))
(setq chkflag (Lwcl lent)) (if chkflag (setq ptlist (reverse ptlist)) )
(command "erase" lent "")
(setq retlist (append retlist (list ptlist))) ;; Top of Extrude ;; bottom of extrude....
(setq botlist '())
(foreach pt ptlist (setq npt (list (car pt) (cadr pt) 0.0)) (setq botlist (append botlist (list npt))) ) (setq retlist (append retlist (list botlist))) ;; bottom complete... ;; sides of extrude....
(setq sidelist '()) (setq ctr 0) (while (< ctr (- (length ptlist) 1)) (setq xpt (nth ctr ptlist)) (setq ypt (nth (1+ ctr) ptlist)) (setq dummylist '()) (setq dummylist (list (list (car xpt) (cadr xpt) 0.0) (list (car ypt) (cadr ypt) 0.0) ypt xpt (list (car xpt) (cadr xpt) 0.0) ) ) (setq sidelist (append sidelist (list dummylist))) (setq ctr (1+ ctr)) ) (setq retlist (append retlist sidelist)))
;;; ! *************************************************************************************************************************************************************************
;;; To return the vertices of the given entity
(defun Info-GetVertices (enty)
(cond ((and enty (setq obj (vlax-ename->vla-object enty)))
(setq objName (vla-get-objectname obj))
(cond ((and (= objName "AcDb3dPolyline")
(Setq coors (vla-get-coordinates obj))
(setq coors (vlax-variant-value coors))
(setq coors (vlax-safearray->list coors))
)
(setq retlst (INFO-CREATELISTSFROMTHELISTOFVALUES coors 3))
)
((and (= objName "AcDbPolyline")
(Setq coors (vla-get-coordinates obj))
(setq coors (vlax-variant-value coors))
(setq coors (vlax-safearray->list coors))
)
(setq retlst (INFO-CREATELISTSFROMTHELISTOFVALUES coors 2))
)
((setq eprp (entget enty))
(setq retlst '())
(while (or (setq vertex (assoc 10 eprp)) (setq vertex (assoc 11 eprp)))
(setq coors (cdr vertex))
(if (not (member coors retlst))
(setq retlst (append retlst (list coors)))
)
(setq eprp (vl-remove vertex eprp))
)
)
)
)
)
retlst
)
;;; ! *************************************************************************************************************************************************************************

;;; To Create the Lists From the List of Values with Specified number of Values
(defun Info-CreateListsFromTheListOfValues (listofValues NumVals)
(setq retVal '())
(setq cntr 1)
(setq coor '())
(cond ((= (rem (length listofValues) NumVals) 0)
(repeat (length listofValues)
(cond ((= cntr NumVals) (setq cntr 1) (setq coor (append coor (list (nth 0 listofValues)))))
((< cntr NumVals) (setq cntr (1+ cntr)) (setq coor (append coor (list (nth 0 listofValues)))))
)
(cond ((= (length coor) NumVals)
(if (not retVal)
(setq retVal (list coor))
(setq retVal (append retVal (list coor)))
)
(setq coor '())
)
)
(Setq listofValues (Cdr listofValues))
)
)
)
retVal
)
;;; ! *************************************************************************************************************************************************************************
(defun Info-List->String (listofValues DelimChar) (if (not DelimChar) (setq DelimChar ",") ) (if (not (setq chkval (vl-remove 'STR (mapcar 'type listofValues)))) (if listofValues (vl-string-trim DelimChar (apply 'strcat (mapcar (function (lambda (x) (strcat x DelimChar))) listofValues)) ) ) ))
;;; ! *************************************************************************************************************************************************************************
(defun Lwcl (ent / LW LST MAXP MINP) ; Writer Evgeniy Elpanov. (setq lw (vlax-ename->vla-object ent)) (vla-GetBoundingBox lw 'MinP 'MaxP) (setq minp (vlax-safearray->list minp) MaxP (vlax-safearray->list MaxP) lst (mapcar (function (lambda (x) (vlax-curve-getParamAtPoint lw (vlax-curve-getClosestPointTo lw x) ) ;_ vlax-curve-getParamAtPoint ) ;_ lambda ) ;_ function (list minp (list (car minp) (cadr MaxP)) MaxP (list (car MaxP) (cadr minp)) ) ;_ list ) ;_ mapcar ) ;_ setq (if (or (<= (car lst) (cadr lst) (caddr lst) (cadddr lst)) (<= (cadr lst) (caddr lst) (cadddr lst) (car lst)) (<= (caddr lst) (cadddr lst) (car lst) (cadr lst)) (<= (cadddr lst) (car lst) (cadr lst) (caddr lst)) ) ;_ or t ) ;_ if) ;_ defun
;;; ! *************************************************************************************************************************************************************************


use this and update your comments

Regards,
GIS Programmers.

Oracle Georaster

Hi Friends,
Here are the simple steps to insert the Raster image into Oracle(Oracle Georaster).

• Make object table

create table Landsat7 (id number,name varchar2(45),georaster sdo_georaster);

• Make raster data table

CREATE TABLE Landsat7_RDT OF SDO_RASTER (PRIMARY KEY(RASTERID, PYRAMIDLEVEL, BANDBLOCKNUMBER,ROWBLOCKNUMBER, COLUMNBLOCKNUMBER))LOB(RASTERBLOCK) STORE AS (NOCACHE NOLOGGING);· execute CREATEDMLTRIGGER on table Landsat7o EXECUTE SDO_GEOR_UTL.CREATEDMLTRIGGER('Landsat7','GEORASTER');

• Set permissions

call dbms_java.grant_permission('MDSYS','SYS:java.io.FilePermission', 'C:\oracle\raster\georaster_table.tif', 'read' );o call dbms_java.grant_permission('GEOSPATIAL','SYS:java.io.FilePermission', 'C:\oracle\raster\georaster_table.tif', 'read' );o call dbms_java.grant_permission('PUBLIC','SYS:java.io.FilePermission', 'C:\oracle\raster\georaster_table.tif', 'read' );o call dbms_java.grant_permission('MDSYS','SYS:java.io.FilePermission', 'C:\oracle\raster\georaster_table.tfw', 'read' );o call dbms_java.grant_permission('GEOSPATIAL','SYS:java.io.FilePermission', 'C:\oracle\raster\georaster_table.tfw', 'read' );o call dbms_java.grant_permission('PUBLIC','SYS:java.io.FilePermission', 'C:\oracle\raster\georaster_table.tfw', 'read' );

• Insert in the landsat7 Object Table.

INSERT INTO Landsat7 VALUES(1,'p174r037',SDO_GEOR.INIT('Landsat7_RDT'));·

• Insert Geotiff with world file. (make Sure that images should be copied into the server. i.e C: means server C: Drive)

Declare

geo SDO_GEORASTER;

BEGINSELECT GEORASTER INTO geo FROM Landsat7 WHERE ID=1 FOR UPDATE;SDO_GEOR.IMPORTFROM(geo,'blocksize=(512,512)','TIFF','file','C:\oracle\raster\georaster_table.tif','WORLDFILE','file','C:\oracle\raster\georaster_table.tfw');UPDATE Landsat7 SET GEORASTER = geo WHERE ID=1;END;/

• set SRID to georaster (WGS84 UTM zone 36)

DECLARE

geo sdo_georaster;

BEGIN

SELECT georaster INTO geo FROM Landsat7 WHERE id=1 FOR UPDATE;sdo_geor.setModelSRID(geo, 32636);UPDATE Landsat7 SET georaster = geo WHERE id=1;

END;

• Set Extend

UPDATE Landsat7 cSET c.georaster.spatialExtent = sdo_geor.generateSpatialExtent(georaster)WHERE c.id = 1;COMMIT;

• Compute Pyramide

DECLARE

geo sdo_georaster;

BEGIN

SELECT georaster INTO geo from landsat7 where id = 1 FOR UPDATE;sdo_geor.generatePyramid(geo, 'rLevel=5, resampling=NN');UPDATE landsat7 SET georaster = geo where id = 1;

COMMIT;

END;

• Check Data and Metadata.

select count(*) from Landsat7;
select count(*) from Landsat7_RDT;
set long 10000;
select a.georaster.metadata from Landsat7 a;
SELECT t.id, sdo_geor.validategeoraster(t.georaster) isvalid from Landsat7 t order by id;

format the above code and use it... please let us know if you need any help.

Regards,
GIS Programmers.

Lat Long to UTM

Hi All,

here is the AutoLisp code to convert the Geographic coordinates into UTM projection system.

(Defun LL2UTM (xval yval)
(setq UTM nil)
(setq statA 6378137.0)
(setq statB 6356752.314)
(setq statF 0.003352811)
(setq statIF 298.2572236)
(setq statRM 6367435.68)
(setq statK0 0.9996)
(setq statE 0.081819191)
(setq statE2 0.006739497)
(setq statN 0.00167922)
(setq ConstA0 6367449.14580084)
(setq ConstB0 16038.4295531591)
(setq ConstC0 16.8326133343344)
(setq ConstD0 0.0219844042737573)
(setq ConstE0 0.000312705217950448)
(setq Sin1 0.00000484813681109536)
(setq ConstE1SQ 0.006739496756587)
(setq Zone (+ 30 (Fix (/ xval 6))))
(setq ZoneCM (- (* 6 Zone) 183))
(setq DeltaLon (/ (* (- xval ZoneCM) 3600) 10000))
(setq LatRad (/ (* yval 3.14159265358979) 180))
(setq LongRad (/ (* xval 3.14159265358979) 180))
(Setq Curve1 (/ (* statA (- 1 (* statE statE))) (/ (expt (- 1 (expt (* statE (Sin LatRad)) 2)) 2) (sqrt (- 1 (expt (* statE (Sin LatRad)) 2))) ) ) )
(setq Curve2 (/ statA (sqrt (- 1 (expt (* statE (Sin LatRad)) 2)))))
(setq MeridArc (- (+ (* ConstA0 LatRad) (* ConstC0 (sin (* LatRad 4))) (* ConstE0 (sin (* LatRad 8))) ) (+ (* ConstB0 (sin (* LatRad 2))) (* ConstD0 (sin (* LatRad 6))) ) ) )
(setq K1 (* MeridArc statK0))
(setq K2 (* Curve2 (sin LatRad) (cos LatRad) (expt Sin1 2) statK0 (/ 100000000 2) ) )
(setq K3 (* (/ (* (expt Sin1 4) Curve2 (sin LatRad) (expt (cos LatRad) 3)) 24 ) (+ (- 5 (expt (/ (sin LatRad) (cos LatRad)) 2)) (* 9 ConstE1SQ (expt (cos LatRad) 2)) (* 4 (expt ConstE1SQ 2) (expt (cos LatRad) 4)) ) statK0 10000000000000000 ) )
(setq K4 (* Curve2 (cos LatRad) Sin1 statK0 10000))
(setq K5 (* (expt (* Sin1 (cos LatRad)) 3) (/ Curve2 6) (+ (- 1 (expt (/ (sin LatRad) (cos LatRad)) 2)) (* ConstE1SQ (expt (cos LatRad) 2)) ) statK0 1000000000000 ) )
(setq RawNorth (+ K1 (* K2 DeltaLon DeltaLon) (* K3 (expt DeltaLon 4))) )
(if (< RawNorth 0) (Setq Northing (+ 10000000 RawNorth)) (Setq Northing RawNorth) )
(setq Easting (+ 500000 (+ (* K4 DeltaLon) (* K5 (expt DeltaLon 3)))))
(setq UTM (list Easting Northing))
UTM
)
Please let us know if you need any help

Regards,

GIS Programmers.

Visual LISP to RDBMS (Oracle/SQL Server).

Hi,

Most of us limit the Auto/Visual Lisp Functionalities to only for AutoCAD.
If we want to perform operations like interacting with RDBMS, DBMS (.mdb), connect to external applications like Microsoft excel/word we choose to go for either AutoCAD VBA or ObjectARX.
The interesting thing is we can perform all these activities using Visual LISP itself. Since Visual Lisp was developed using ActiveX technology. We can now perform all the operations in visual LISP those were possible in VBA only.

In this article we will tell you how to connect to Oracle using Visual LISP.

To connect to Oracle in VBA first will go to references add the ado dll then we will write the connection functions query functions etc. like wise in Visual Lisp also we need to import the dll file then we have to write the required functions.

• Vlax-import-type-library
  By using this method we can import any valid dll functionalities in to Visual Lisp. It takes 4 arguments.
  1. :tlb-filename path and name of the dll/tlb file which needs to be imported.
  2. :Methods-prefix this will concatenate the string given by user to all the ‘Methods’ available in the dll.
  3. :Properties-prefix this will concatenate the string given by user to all the ‘Properties’ available in the dll.
  4. :Constants-prefix this will concatenate the string given by user to all the ‘Constants’ available in the dll.
  
  
  
  
• import dll Code.
  (defun ImportAdoDll ()
  (setq FileName "C:\\Program Files\\Common Files\\System\\ado\\msado15.dll")
  (cond ((not LISPADOC-adAddNew)
  (if (findfile FileName)
  (vlax-import-type-library :tlb-filename FileName :methods-prefix "LISPADOM-" :properties-prefix "LISPADOP-" :constants-prefix "LISPADOC-"
  )
  )
  )
  (t t)
  )
  )
  Remember one thing that we have to import dll only once per a AutoCAD session.
  
• Connect to Oracle code:
  
  (Defun ConnectOracle (DataSource Username Password / adoConn)
  (if (not lispadop-get-version)
  (ImportAdoDll)
  )
  (cond ((setq adoConn (vlax-create-object "Adodb.Connection"))
  (cond ((and DataSource Username Password)
  (Setq conString (strcat "Driver={Microsoft ODBC for Oracle};Server=" DataSource ";Uid=" Username ";Pwd=" Password))
  )
  )
  (vlax-invoke-method adoConn "Open" conString nil nil -1)
  (if (= (LISPADOP-get-State adoConn) 1)
  adoConn
  )
  )
  )
  )
  
  Note: In the above code ‘DataSource’ is service name.
  
• Code to get all the table names available in the connected database:
  
  (defun GetTables (object / adoxCat retlst tables)
  (cond ((setq adoxCat (vlax-create-object "ADOX.Catalog"))
  (vlax-put-property adoxCat "ActiveConnection" object)
  (cond ((and (Setq tables (vlax-get-property adoxCat "Tables"))
  (setq tabsCnt (vlax-get-property tables "Count"))
  (> tabsCnt 0)
  )
  (setq ind 0)
  (Setq retlst '())
  (while (< ind tabsCnt)
  (setq tab (vlax-get-property tables "Item" ind))
  (Setq tabtype (vlax-get-property tab "Type"))
  (cond ((and (= tabtype "TABLE")
  (Setq tabName (vlax-get-property tab "Name"))
  (not (wcmatch tabName "*$*"))
  (not (wcmatch tabName "*_*"))
  )
  (setq retlst (append (list tabName) retlst))
  )
  )
  (Setq ind (1+ ind))
  )
  )
  )
  )
  )
  retlst
  )
• Code to execute to Query
  
  (Defun ExecuteQuery (Connection QueryString)
  (Setq retval (vlax-invoke-method Connection "Execute" QueryString nil -1))
  )
  
• To get The Record Set from the Connection based on the Query String Provided
  
  (Defun GetRecordSet (Connection QueryString)
  (cond ((Setq adoRecSet (vlax-create-object "ADODB.Recordset"))
  (vlax-put-property adoRecSet "CursorLocation" LISPADOC-adUseClient)
  (vlax-put-property adoRecSet "ActiveConnection" Connection)
  (vlax-put-property adoRecSet "LockType" LISPADOC-adLockOptimistic)
  (vlax-put-property adoRecSet "CursorType" Lispadoc-adOpenDynamic)
  (vlax-put-property adoRecSet "Source" QueryString)
  (vlax-invoke-method adoRecSet "Open" nil nil nil nil -1)
  (if (> (vlax-get-property adoRecSet "RecordCount") 0)
  adoRecSet
  )
  )
  )
  )
  
  
• To Get the Column Names from the Recordset:
  (Defun getRecordSetFields (RecordSet / Fields ind maXInd retList field fieldName)
  (cond ((setq Fields (vlax-get-property RecordSet "Fields"))
  (Setq ind 0)
  (Setq maXInd (vlax-get-property Fields "Count"))
  (Setq retList '())
  (while (< ind maXInd)
  (Setq field (vlax-get-property Fields "Item" ind))
  (Setq fieldName (vlax-get-property field "Name"))
  (if retList
  (Setq retList (append retList (list fieldName)))
  (Setq retList (list fieldName))
  )
  (Setq ind (1+ ind))
  )
  )
  )
  retList
  )
  
• To Get all the Data in the Recordset along with the Field Names:
  
  (Defun GetDataFromRecordSet (RecordSet / rcsFields retvals)
  (cond ((and (Setq rcsFields (GETRECORDSETFIELDS RecordSet))
  (setq retvals (getRecordSetValues RecordSet))
  )
  (append (list rcsFields) retvals)
  )
  )
  )
  
  
• To Get all the Rows Data in the Recordset
  
  (Defun getRecordSetValues (RecordSet / rows ReturnValue retList)
  (cond ((And (= (vlax-get-property RecordSet "State") 1)
  (/= (vlax-get-property RecordSet "EOF") :vlax-true)
  (Setq rows (vlax-invoke-method RecordSet "GetRows" lispadoc-adGetRowsRest lispadoc-adBookmarkCurrent nil))
  (setq ReturnValue (vlax-safearray->list (vlax-variant-value rows)))
  )
  (setq retList (apply 'mapcar
  (cons 'list
  (mapcar '(lambda (InputList) (mapcar '(lambda (Item) (GetVariantvalue Item)) InputList))
  ReturnValue
  )
  )
  )
  )
  )
  )
  retList
  )
  
  
  
  
  
  
• To Get the Database Data types related to AutoCAD data types
  
  (defun GetVariantvalue (VariantItem / VariantType)
  (cond ((or (= vlax-vbCurrency (setq VariantType (vlax-variant-type VariantItem)))
  (= vlax-vbDecimal VariantType)
  )
  (vlax-variant-value (vlax-variant-change-type VariantItem vlax-vbDouble))
  )
  ((= vlax-vbDate VariantType) (1900BasedJulianToCalender (vlax-variant-value VariantItem)))
  ((= vlax-vbBoolean VariantType)
  (if (= :vlax-true (vlax-variant-value VariantItem))
  "True"
  "False"
  )
  )
  ((or (= vlax-vbInteger VariantType)
  (= vlax-vbDouble VariantType)
  (= vlax-vbString VariantType)
  (= vlax-vbSingle VariantType)
  (= vlax-vbLong VariantType)
  )
  (vlax-variant-value VariantItem)
  )
  ((= vlax-vbArray VariantType) (vlax-safearray->list (vlax-variant-value VariantItem)))
  ((= vlax-vbnull VariantType) "")
  ((/= vlax-vbnull VariantType)
  (setq VariantItem (vlax-variant-change-type VariantItem vlax-vbString))
  (vlax-variant-value VariantItem)
  )
  )
  )
  
  
  (defun floor (number /)
  (if (> number 0)
  (fix number)
  (fix (- number 1))
  )
  )
  
  
  
• Closing the Connection
  
  (defun CloseConnection (Object)
  (cond ((= (vlax-get-property Object "State") 1) (vlax-invoke-method Object "Close")))
  (if (/= Object :vlax-null)
  (vlax-release-object Object)
  )
  )

Regards,

GIS Programmers.

GIS programmers Job Openings

Hi All,

We found some of the current openings for GIS programmers in a Hyderabad-India based company.

Those guys who are interested they can forward their mail_ids to this blog.So that we will get in touch with them

All the Best,

GIS-Programmers

ObjectARX -> Oralce Spatial

Hi Friends,

if anybody help how to intract with oracle spatial using ObjectArx please post in this blog.
we are happy to help you out.

Thank You,
GIS programmers

ArcSDE register Oracle Spatial

Hi Friends,
here is the procedure to register the oracle spatial to ArcSDE.
1. insert to metadata into user_sdo_geom_metadata view by using the following syntax.
"insert into user_sdo_geom_metadata (TABLE_NAME,COLUMN_NAME,DIMINFO, SRID) values ('" & strnewtablename & "','GEOM',SDO_DIM_ARRAY(SDO_DIM_ELEMENT('X', minx, maxX, 0.005),SDO_DIM_ELEMENT('Y', miny, maxy, 0.005)),SRID(enter ur SRID Number))"
2. create the spatial index on the table.
3. run the following command at the SDE server.
sdelayer -o register -e p3 -l TABLE_NAME,COLUMN_NAME-C DBID,USER -u oracleUserName -p oraclePassword.

please let us know if you any problems.

Thank You,
GIS programmers.

AutoLISP free stuff

Hi All,

Here are some free AutoLisp programs.
if you have any specific project requirements please let us know ......

Regards,
India GIS programmers

Services

Hi all,
this blog has been started by 3 GIS programmers from india.
we have created this blog for GIS programming support.
we will provide you programming support in following domains.
1. Autodesk

• ObjectARX
• AutoCAD VBA.
• VisualLISP.
• Autodesk FDO.

2. Bentely

• Microstation VBA.
• MDL.

3. ArcGIS.

• ArcObjects.
• ArcEngine.
• ArcIMS.
• ArcFM.
• ArcServer.

4. Oracle

• Oracle Spatial.

Please post your requests for any kind of GIS programming support.

Thank You,