cad制图中,常常通过支座标准化复用,比如图框、电子签名,还可以其他大样等。可以直接使用或者参照修改后修改。在插入标准块中,往往寻找图块所在的文件以及打开该文件耗费较多的等待时间,因此将其代码化通过命令插入较为提高效率。
插入电子图签
效果:将所有的电子签名字制作成标准块,按一定规则命名,调动dzq命令将显示所有电子签块名称,选择需要的块进行插入。
首先,获取所有电子签块名getBlocksname
(defun getBlocksname (DwgName / *ACAD* *DOCS* BLOCKS DBXDOC BLK namelst)
;getBlocksname 获取图形中的所有块名
;designed by 林霄云 2019年5月31日
(setq *acad* (vlax-get-acad-object) *DOCS* (vla-get-Documents *ACAD*))
;(setq blocks (vla-get-blocks (vla-get-ActiveDocument *acad*)))
;(setq dbxDoc (vla-GetInterfaceObject *acad* (GetObjectDBXVer)));"AutoCAD.Application.20"
(setq DwgName (findfile DwgName))
;(if (not (member DwgName (opendwglist)))
(if (not (hasopened DwgName))
(progn
(setq dbxDoc (vla-GetInterfaceObject *acad* (GetObjectDBXVer)));
(vla-open dbxDoc (findfile DwgName))
);progn
(progn
(setq dbxDoc (vla-item *docs* (strcat (vl-filename-base DwgName)(vl-filename-extension DwgName))))
)
);if 根据文件是否打开判断,采用合适的doc对象
;(vla-open dbxDoc (findfile "标准块引用/电子签名.dwg"))
(setq blocks (vla-get-blocks dbxDoc))
(vlax-for BLK blocks
(if (and (not (wcmatch (substr (vla-get-name BLK) 1 1) "`*"))
(= (vla-get-isxref BLK) :vlax-false)
) ;去除系统块、匿名块和参照类对象
(setq namelst (append namelst (list (vla-get-name BLK))))
)
)
(vlax-release-object dbxDoc)
;(vla-item blocks BlkName)
namelst
)
判断文件是否打开hasopened
注意的是,应该判断该标准块是否已经打开(hasopened DwgName)
,因为这对于获取doc对象有所差别。
(defun hasopened( dwgname / *ACAD* *DOC* *DOCS* flag doc)
;返回dwgname是否已经打开
;designed by 林霄云 2019年6月5日
(setq *ACAD* (vlax-get-acad-object)
;*DOC* (vla-get-ActiveDocument *acad*)
*DOCS* (vla-get-Documents *ACAD*)
flag nil
dwgname (findfile dwgname)
)
(vlax-for doc *DOCS*
(if (= dwgname (vla-get-fullname doc))
(setq flag T)
) ;if
);vlax-for
flag
);defun
深度复制对象到当前文档copyobjects
采用copyobjects方法。根据说明得传递文档对象、待复制的对象数组以及其owner。
(defun CopyBlock (DwgName BlkName / *ACAD* *DOCS* BLOCKS DBXDOC NUM)
;CopyBlock 获取图形中的指定块名
;designed by 林霄云 2019年5月31日
(setq *acad* (vlax-get-acad-object) *DOCS* (vla-get-Documents *ACAD*) )
(setq blocks (vla-get-blocks (vla-get-ActiveDocument *acad*)))
;(setq dbxDoc (vla-GetInterfaceObject *acad* (GetObjectDBXVer)));"AutoCAD.Application.20"
(setq DwgName (findfile DwgName))
;(if (not (member DwgName (opendwglist)))
(if (not (hasopened DwgName))
(progn
(setq dbxDoc (vla-GetInterfaceObject *acad* (GetObjectDBXVer)));
(vla-open dbxDoc DwgName)
);progn
(progn
(setq dbxDoc (vla-item *docs* (strcat (vl-filename-base DwgName)(vl-filename-extension DwgName))))
)
);if 根据文件是否打开判断,采用合适的doc对象
(setq num (vla-item (vla-get-blocks dbxDoc) BlkName))
(vla-CopyObjects
dbxDoc
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbObject
'(0 . 0)
)
(list num)
)
blocks
)
(vlax-release-object dbxDoc)
(vla-item blocks BlkName)
)
注意的是,同样需要判断文档是否已经打开。
主程序调用insert
(defun c:dzq( / tk-sym dwgname oldlayer tk-scale )
(setq oldlayer (getvar 'clayer))
(setq dwgname "标准块引用/电子签名.dwg")
(setq tk-scale hnu:dimscale)
(setq tk-sym (getstring t (strcat "\n输入电子签名[" (strcase (LM:LST->STR (getBlocksname dwgname )"/")) "]")))
;(cond (wcmatch tk-sym "@*@") (setq tk-sym (strcat "-" tk-sym "-")))
(princ tk-sym)
(copyblock dwgname tk-sym)
(setup "dzqm")
;(command "-INSERT" dwgname ^c "-INSERT" tk-sym PAUSE tk-scale tk-scale 0)
(command "-insert" tk-sym PAUSE tk-scale tk-scale 0 )
(setvar 'clayer oldlayer)
(princ)
)
Last Modified·2019年6月5日 18:24
您尚未登录,请先登录才能评论。