插入标准块应用——插入电子签

linxiaoyun 2019.6.5 18:22 195 0
软件应用 autolisp

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

暂无评论

您尚未登录,请先才能评论。