我想知道以下代码如何将其编码到VBA。类似于我们在autocad中将多段线区域返回excel中所做的操作。该命令通过excel宏发送
任何帮助都太棒了
- (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)
- )
-
-
|