本帖最后由 作者 于 2007-11-7 16:47:27 编辑
;;;合并标注样式(还没有测试) ;;;语法(lt:dimstyle-merge <要合并的标注样式列表> <目标标注样式>) (defun lt:dimstyle-merge (dstlst dst / doc blks n space obj app) (setq doc (vla-get-activedocument (vlax-get-acad-object)) blks (vla-get-blocks doc) dstlst (mapcar 'strcase dstlst) dst (strcase dst) n 0 ) (if (member (strcase (getvar "dimstyle")) dstlst) (setvar "dimstyle" dst) ) (while (< n (vla-get-count blks)) (setq space (vla-item blks n)) (vlax-for obj space (if (and (= (vla-get-ObjectName obj) "AcDbRotatedDimension") (member (cdr (assoc 3 (setq app (entget (vlax-vla-object->ename obj))))) dstlst) ) (entmod (subst (cons 3 dst) (assoc 3 app) app)) ) ) (setq n (1+ n)) ) (mapcar '(lambda (x) (if (/= x (strcase dst)) (vl-catch-all-apply 'vla-delete (list (vla-item (vla-get-dimstyles doc) x))) ) ) dstlst ) (vla-regen doc 1) )
|