求通用函数，可以不打开图纸批量执行自定义函数

革天明 · 发表于 2013-12-13 12:35:06

要求：通用函数，可批量不打开图纸的情况下，执行自定义函数，如查找替换字符串、获取导出字典、字体修改等，
其它同学有其它自定义函数要求的，可以参与回复。

阿然 · 发表于 2013-12-13 14:57:25

前辈早就写过了

;| (xo-infdo fname vcol func) = dbx技术对文件内集合进行操作
参数: fname = cad文件(*.dwg格式)
vcol = 集合列表.如'(modelspace paperspace)
func = 操作函数名, 如: 'xx 或 '(lambda(x)....)
操作函数必须含一个变量(集合内实体). 如: (defun xx (x) ...)
返回: 分别操作的表(表内容根据函数来定义).
说明: vcol可以是如下集合:
All Collection Objects(所有的集合实体:)
Blocks Dictionaries DimStyles funccuments FileDependencies Groups
Hyperlinks Layers Linetypes MenuBar MenuGroups ModelSpace
PaperSpace PlotConfigurations PopupMenu PopupMenus
RegisteredApplications SelectionSets TextStyles Toolbar
Toolbars UCSs Viewports Views
|;
(defun xo-infdo (fname vcol func / doc CNAME RET
VERKEY DOC E ENT I REGKEY SS
SSBLK ATTS BLKS CDOC CNAMES DOCS llays
)
(setq fname (strcase fname))
(print fname)
(setq cdoc (vla-get-activedocument (vlax-get-acad-object)))
(setq cname (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")))
;; 当前文件名.
(vlax-for x (vlax-get (vlax-get-acad-object) 'documents)
(setq docs (cons x docs))
)
(setq cnames
(mapcar
'(lambda (x)
(strcase (strcat (vla-get-path x) "\\" (vla-get-name x))
)
)
docs
)
)
;(setq fname cname)
(if (member fname cnames)
(progn
;; v1.5加入,锁定图层解锁.>>可放入为xo-infdo的参数.后补>>
(evaldo cdoc
(vla-get-layers cdoc)
'(lambda (x)
(if (= :vlax-true (vla-get-lock x))
(progn (setq llays (cons x llays))
(vla-put-lock x :vlax-false)
)
)
)
)
(evalcur
(setq
doc (nth (- (length docs) (length (member fname cnames)))
docs
)
)
) ;处理当前文件,evalcur函数
(mapcar '(lambda (x) (vla-put-lock x :vlax-true)) llays)
)
;; 处理非当前文件.
(progn
(setq verkey (if (> (atoi (getvar "AcadVer")) 15)
".16"
""
)
*DBXDOC (vla-getinterfaceobject
(vlax-get-acad-object)
(strcat "ObjectDBX.AxDbDocument" verkey)
)
)
(vla-open *dbxdoc fname :vlax-false) ;open
;; v1.5加入,锁定图层解锁.>>可放入为xo-infdo的参数.后补>>
(evaldo *dbxdoc
(vla-get-layers *dbxdoc)
'(lambda (x)
(if (= :vlax-true (vla-get-lock x))
(progn (setq llays (cons x llays))
(vla-put-lock x :vlax-false)
)
)
)
)
;;
(setq
ret (mapcar '(lambda (x)
(evaldo *dbxdoc (vlax-get *dbxdoc x) func)
;evaldo 函数
)
vcol
)
) ;(vlax-dump-object *dbxdoc T)
;; v1.5加入,锁定图层解锁恢复>>
(mapcar '(lambda (x) (vla-put-lock x :vlax-true)) llays)
;;
(vlax-invoke *dbxdoc 'saveas fname)
(vlax-release-object *dbxdoc)
)
)
ret
)

;| (xo-infdo fname vcol func) = dbx技术对文件内集合进行操作 
参数: fname = cad文件(*.dwg格式) 
      vcol = 集合列表.如'(modelspace paperspace) 
      func = 操作函数名, 如: 'xx 或 '(lambda(x)....) 
             操作函数必须含一个变量(集合内实体). 如: (defun xx (x) ...) 
返回: 分别操作的表(表内容根据函数来定义). 
说明: vcol可以是如下集合: 
All Collection Objects(所有的集合实体:) 
Blocks   Dictionaries  DimStyles  funccuments  FileDependencies  Groups 
Hyperlinks  Layers  Linetypes  MenuBar  MenuGroups  ModelSpace   
PaperSpace  PlotConfigurations  PopupMenu  PopupMenus   
RegisteredApplications  SelectionSets  TextStyles  Toolbar 
Toolbars  UCSs  Viewports  Views 
|; 
(defun xo-infdo        (fname        vcol   func   /             doc    CNAME  RET 
                 VERKEY        DOC    E      ENT    I            REGKEY SS 
                 SSBLK        ATTS   BLKS   CDOC   CNAMES DOCS   llays 
                ) 
  (setq fname (strcase fname)) 
  (print fname) 
  (setq cdoc (vla-get-activedocument (vlax-get-acad-object))) 
  (setq cname (strcat (getvar "DWGPREFIX") (getvar "DWGNAME"))) 
  ;; 当前文件名. 
  (vlax-for x (vlax-get (vlax-get-acad-object) 'documents) 
    (setq docs (cons x docs)) 
  ) 
  (setq        cnames 
         (mapcar 
           '(lambda (x) 
              (strcase (strcat (vla-get-path x) "\\" (vla-get-name x)) 
              ) 
            ) 
           docs 
         ) 
  ) 
                                        ;(setq fname cname) 
  (if (member fname cnames) 
    (progn 
      ;; v1.5加入,锁定图层解锁.>>可放入为xo-infdo的参数.后补>> 
      (evaldo cdoc 
              (vla-get-layers cdoc) 
              '(lambda (x) 
                 (if (= :vlax-true (vla-get-lock x)) 
                   (progn (setq llays (cons x llays)) 
                          (vla-put-lock x :vlax-false) 
                   ) 
                 ) 
               ) 
      ) 
      (evalcur 
        (setq 
          doc (nth (- (length docs) (length (member fname cnames))) 
                   docs 
              ) 
        ) 
      )                                        ;处理当前文件,evalcur函数 
      (mapcar '(lambda (x) (vla-put-lock x :vlax-true)) llays) 
    ) 
    ;; 处理非当前文件. 
    (progn 
      (setq verkey  (if        (> (atoi (getvar "AcadVer")) 15) 
                      ".16" 
                      "" 
                    ) 
            *DBXDOC (vla-getinterfaceobject 
                      (vlax-get-acad-object) 
                      (strcat "ObjectDBX.AxDbDocument" verkey) 
                    ) 
      ) 
      (vla-open *dbxdoc fname :vlax-false) ;open 
      ;; v1.5加入,锁定图层解锁.>>可放入为xo-infdo的参数.后补>> 
      (evaldo *dbxdoc 
              (vla-get-layers *dbxdoc) 
              '(lambda (x) 
                 (if (= :vlax-true (vla-get-lock x)) 
                   (progn (setq llays (cons x llays)) 
                          (vla-put-lock x :vlax-false) 
                   ) 
                 ) 
               ) 
      ) 
      ;; 
      (setq 
        ret (mapcar '(lambda (x) 
                       (evaldo *dbxdoc (vlax-get *dbxdoc x) func) 
                                        ;evaldo 函数 
                     ) 
                    vcol 
            ) 
      )                                        ;(vlax-dump-object *dbxdoc T) 
      ;; v1.5加入,锁定图层解锁恢复>> 
      (mapcar '(lambda (x) (vla-put-lock x :vlax-true)) llays) 
      ;; 
      (vlax-invoke *dbxdoc 'saveas fname) 
      (vlax-release-object *dbxdoc) 
    ) 
  ) 
  ret 
)

革天明 · 发表于 2013-12-13 15:17:25

阿然发表于 2013-12-13 14:57
前辈早就写过了

能改写一下变成完整程序吗？就是不打开图纸，完成图纸内MTEXT和TEXT字体的转变

革天明 · 发表于 2013-12-13 20:47:15

阿然发表于 2013-12-13 14:57
前辈早就写过了

能否写个简单的例子，自定义是函数是在每个DWG文档中画条线（command "line" (list 0 0) (list 2 7) "")
func = 操作函数名, 如: 'xx 或 '(lambda(x)....)
操作函数必须含一个变量(集合内实体). 如: (defun xx (x) ...)
这句话说必须含一个变量（集合内实体），这句不能理解。

革天明 · 发表于 2013-12-14 22:11:15

有没有人点拨一下啊

革天明 · 发表于 2013-12-16 21:18:00

悬赏贴掉的无影无踪

风树 · 发表于 2013-12-16 21:25:24

帮顶

Lisper · 发表于 2013-12-16 23:28:28

革天明发表于 2013-12-13 20:47
能否写个简单的例子，自定义是函数是在每个DWG文档中画条线（command "line" (list 0 0) (list 2 7) "")
...

自定义函数不能有Command命令，必须全部使用VLA函数来编辑objectdbx文档！
否则你可以参考猫老师的这个帖子：http://bbs.mjtd.com/thread-108697-1-1.html

革天明 · 发表于 2013-12-17 08:56:32

Lisper 发表于 2013-12-16 23:28
自定义函数不能有Command命令，必须全部使用VLA函数来编辑objectdbx文档！
否则你可以参考猫老师的这个帖 ...

谢谢指点，去学习一下

lionguns · 发表于 2015-7-23 20:22:35

留名@_@^o^

账号		自动登录	找回密码
密码			注册

[函数] 求通用函数，可以不打开图纸批量执行自定义函数

相关帖子