spatialite and Cad

53 views
Skip to first unread message

Daniel Marcotte

unread,
Jul 29, 2010, 3:34:52 AM7/29/10
to spatiali...@googlegroups.com
Hi all, I have written a Sqlite module for Autolisp that runs on a few
cad platforms.. let me know if you want a copy : )
I've posted the source at www.theswamp.org (its a private forum so
you'll need to sign in)

example autolisp code

(DEFUN C:Test1 ( / activedocument db e iacadapplication modelspace
paperspace res)
(vl-load-com)
(setq IAcadApplication (vlax-get-acad-object)
ActiveDocument (vla-get-ActiveDocument IAcadApplication)
ModelSpace (vla-get-ModelSpace ActiveDocument)
)
(setq db "C:\\Dev\\Lisp\\Spatialite\\libspatialite\\dll\\test-2.3.sqlite")
(DSQL_OPEN db)

; load spatialite
(DSQL_loadext db
"C:\\Dev\\Lisp\\Spatialite\\libspatialite\\dll\\libspatialite-2.dll")
(setq res (DSQL_QUERY db "SELECT X(Geometry), Y(Geometry) from Towns;"))
(DSQL_CLOSE db)
(foreach e (cdr res)
(vla-AddPoint ModelSpace (vlax-3d-point (list (nth 0 e) (nth 1 e) 0)))
)
)

(DEFUN C:Test2 ( / activedocument cnt db iacadapplication modelspace
paperspace ptlist res res2)
(setq IAcadApplication (vlax-get-acad-object)
ActiveDocument (vla-get-ActiveDocument IAcadApplication)
ModelSpace (vla-get-ModelSpace ActiveDocument)
clr 1
)
(setq db "C:\\Dev\\Lisp\\Spatialite\\libspatialite\\dll\\test-2.3.sqlite")
(DSQL_OPEN db)

(DSQL_loadext db
"C:\\Dev\\Lisp\\Spatialite\\libspatialite\\dll\\libspatialite-2.dll")

(setq res (DSQL_QUERY db "SELECT PK_UID ,
NumPoints(ExteriorRing(Geometry)) FROM Regions;"))
(foreach e (cdr res)
(setq cnt 1)
(setq ptlist '())

(while (> (cadr e) cnt)
(setq res2 (DSQL_QUERY db
(strcat"SELECT X(PointN(ExteriorRing(Geometry), %d)), "
" Y(PointN(ExteriorRing(Geometry), %d)) FROM
Regions WHERE PK_UID = '%d';")
cnt cnt (car e) ))

(setq ptlist (append ptlist (cdr res2)))
(setq cnt (1+ cnt))
)
(if (>(length ptlist)1)
(progn
(DrawLwPolyLine ModelSpace ptlist clr)
(setq clr (1+ clr))
(if (= clr 6)
(setq clr 1))
)
)
)
(DSQL_CLOSE db)
)


(defun DrawLwPolyLine (DocSpace PointList clr / e plist ptl o)
(setq ptl PointList
plist '()
)
(foreach e ptl
(setq plist (cons (car e) plist)
plist (cons (cadr e) plist)
)
)
(setq o
(vla-addLightweightPolyline
DocSpace
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbDouble
(cons 0
(-
(length plist)
1
)
)
)
(reverse plist)
)
)
)
(vla-put-closed o t)
(vla-put-color o clr)
)

Capture.PNG
Reply all
Reply to author
Forward
0 new messages