TheSwamp
Code Red => VB(A) => Topic started by: MSTG007 on May 15, 2014, 11:43:42 AM
-
I was wondering with the following code how I could get this to be coded to VBA. Similar to what we did with the polyline area in autocad back to excel. The Command was sent via excel macro.
Any help would be awesome.
(defun c:zm2st (/ *ACAD* C3D C3DDOC LOCATION NTWRK NTWRKS PROD PRODSTR PT STRC STRCNAME STRUCTURES)
(vl-load-com)
(setq prod (vlax-product-key))
(setq prodStr (strcat "AeccXUiPipe.AeccPipeApplication"
(cond ((vl-string-search "\\R17.0\\" prod)
".4.0"
)
;;2007
((vl-string-search "\\R17.1\\" prod)
".5.0"
)
;;2008
((vl-string-search "\\R17.2\\" prod)
".6.0"
)
;;2009
((vl-string-search "\\R18.0\\" prod)
".7.0"
)
;;2010
((vl-string-search "\\R18.1\\" prod)
".8.0"
)
;;2011
((vl-string-search "\\R18.2\\" prod)
".9.0"
)
;;2012
((vl-string-search "\\R19.0\\" prod)
".10.0"
)
;;2013
((vl-string-search "\\R19.1\\" prod)
".10.3"
)
;;2014
(t "")
)
)
)
(if (and (setq *acad* (vlax-get-acad-object))
(setq C3D (vla-getinterfaceobject *acad* prodStr))
(setq C3Ddoc (vla-get-activedocument C3D))
)
(progn
(setq ntwrks (vlax-get c3ddoc 'pipenetworks))
(setq strcname (getstring "\nStructure name to zoom to: " t))
(vlax-for ntwrk ntwrks
(if (not strc)
(progn
(vl-catch-all-apply '(lambda ()
(setq structures (vlax-get ntwrk 'structures))
(setq strc (vlax-invoke structures 'item strcname))
)
'())
)
)
)
(if strc
(progn
(setq location (vlax-get strc 'position))
(setq pt (list (vlax-get location 'x) (vlax-get location 'y)))
(command "zoom" "c" pt "40")
)
(progn
(princ (strcat "\nStructure \"" strcname "\" not found."))
)
)
)
)
(princ)
)