lisp克隆

admin1

[code];;;name:各种
;;;desc:常量,以全局变量为函数
;;;arg:各种
;;;return:各种
;;;example:各种
(setq
  *En2Obj* vlax-Ename->vla-Object       ;lisp转为vla对象
  *Obj2En* vlax-vla-object->ename       ;vla转lisp对象
  *2PI* (* PI 2)                        ;圆周率*2
  *0.5PI* (/ PI 2)                      ;圆周率*0.5
  *0.25PI* (/ PI 4)                     ;圆周率*0.25
  ;常用VLA对象、集合
  *ACAD* (vlax-get-acad-object)         ;取得CAD作为根对象
  *DOCS* (vla-get-Documents *ACAD*)     ;取得文档集合
  *DOC* (vla-get-ActiveDocument *ACAD*) ;取得当前活动文档
  *MS* (vla-get-modelSpace *DOC*)       ;                的模型空间集合
  *PS* (vla-get-paperSpace *DOC*)       ;                的布局空间集合
  *BLKS* (vla-get-Blocks *DOC*)         ;                的块表
  *LAYS* (vla-get-Layers *DOC*)         ;                的图层集合
  *LTS* (vla-get-Linetypes *DOC*)       ;                的线型集合
  *STS* (vla-get-TextStyles *DOC*)      ;                的字体集合
  *GRPS* (vla-get-groups *DOC*)         ;                的组集合
  *DIMS* (vla-get-DimStyles *DOC*)      ;                的标注集合
  *LOUTS* (vla-get-Layouts *DOC*)       ;                的布局集合
  *VPS* (vla-get-Viewports *DOC*)       ;                的视口集合
  *VS* (vla-get-Views *DOC*)            ;                的图纸集合
  *DICS* (vla-get-Dictionaries *DOC*)   ;                的词典集合
  ;常用的几个外部接口对象
  *FSO* (vlax-get-or-create-object "Scripting.FileSystemObject")
  *WSH* (vlax-get-or-create-object "wscript.shell")
  *SHELL* (vlax-get-or-create-object "Shell.Application");系统程序
  *SCR* (vlax-get-or-create-object "ScriptControl")
  *WBEM* (vlax-get-or-create-object "WbemScripting.SWbemLocator")
  ;防止高版本调整命令
  *CMDF* (if vl-cmdf vl-cmdf command)  ;command-s
  *ERROR-A* vl-catch-all-apply         ;截获错误
  *ERROR-P* vl-catch-all-error-p       ;截获的东西是不是存在错误
  *ERROR-M* vl-catch-all-error-message ;输出错误信息
)

;;;name: BF-CopyBlock
;;;desc: 复制路径中的块到当前图纸
;;;arg:  路径
;;;arg:  块名称
;;;return: 成功当前图纸的块壳,没有nil
;;;example: (BF-CopyBlock (BF-Catalog "03.用户配置\\00.制图规范.dwg") "SD_剖断线")
(defun BF-CopyBlocks (#DwgName #BlkName / DBXDOC acver aa)
  (setq DBXDOC
        (vla-GetInterfaceObject
           *ACAD*
           (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
             "ObjectDBX.AxDbDocument"
             (strcat "ObjectDBX.AxDbDocument." (itoa acVer));;增加判断CAD版本
           )
         )
  )
  (if (and (findfile #DwgName);判断是否路径和块名存在
           (not (*ERROR-P* (*ERROR-A* 'vla-open (list DBXDOC #DwgName))));打开没有错误
           (progn
             (vlax-for ^zibiao (vla-get-blocks DBXDOC)
               (if (= #BlkName (vla-get-name ^zibiao));判断DBX图纸含有这个块
                   (setq aa T)
               )
             )
             aa
           );这个progn防止vlax-for运行结束返回nil
      )
      (progn
        (vla-CopyObjects ;深度克隆
          DBXDOC         ;DBX图纸的数据
          (vlax-safearray-fill                                ;保存数据-块壳的数据保存到新变体中
            (vlax-make-safearray vlax-vbObject'(0 . 0))       ;创建数组;obj类型;上界下界
            (list (vla-item (vla-get-blocks DBXDOC) #BlkName));块表记录
          )
          *BLKS*         ;粘贴到本图的块表中
        )
;;      (progn ;这个只能复制到块内的图元,动态块无法复制
;;         (vla-add *BLKS* (vlax-3d-point '(0 0 0)) bname) ;把块信息加入块集合,基点,块名称->返回块表记录
;;         (setq objs nil);块内图元数量计数器
;;         (vlax-invoke
;;           DBXDOC       ;在DBX中
;;           'CopyObjects ;复制
;;           (vlax-for ^a (vla-item (vla-get-blocks DBXDOC) bname);块集合->块壳->块内的所有图元
;;             (setq objs (cons ^a objs))
;;           )
;;           (vla-item *BLKS* bname);到本图的块中
;;         )
;;      )
        (vlax-release-object DBXDOC);关闭图纸
        (vla-item *BLKS* #BlkName);返回值
      )
  )
)[/code]