利用高版CAD的图层归并命令laymrg处理参照图层
本帖最后由 masterlong 于 2018-9-16 20:03 编辑最近处理一批图纸
原始图纸不知道过了多少人的手
图层乱的一塌糊涂
主要就是多次参照导致
实在受不了了
编了这个程序应急
原始文件645个图层
合并处理后132个图层
因为对参照的应用不熟悉
有一点无法确认——
手上的dwg里的参照方式好像是“融入”还是别的啥
反正是不再需要参照原始dwg
对于需要原始参照dwg的图纸
这个程序还有没有效
就不知道了
;;qq000```参照图层归并
;;————————需要express函数支持
;;————————利用高版本CAD里的图层合并命令laymrg，归并处理参照图层
;;————————用的CAD是2012版，不知道2008或2010是否有这个命令
(defun c:qq000()
(command "layer" "u" "*" "")
(textpage)
(vl-load-com)
(setq *acad* (vlax-get-acad-object)
*doc* (vla-get-ActiveDocument *acad*)
*aboutp* vlax-get-Property
*LAYERS* (vla-get-Layers *doc*)
)
(c:qq000__参照图层归并)
)
(defun c:qq000__参照图层归并()
;0000``````修改图层名，采用2012中图层合并命令（滤除不修改的）
(reflay)
(foreach x alllayname
(setq xxx (tiquczlayernm x))
;;(setq divnmlist (dos_strtokens x "$"))
;;(setq xxx (last divnmlist))
(if (tblsearch "layer" xxx)
(if (/= x xxx)
(command "laymrg" "n" x "" "n" xxx "y")
)
(progn
(command "rename" "la" x xxx)
(reflay)
)
)
)
(vla-PurgeAll *doc*)
(princ)
)
;;获取图层列表
(defun reflay()
(setq alllayname (getalllayname))
;;(setq alllayname (delsame alllayname))
)
;;返回全部图层列表，不设定名称大小写
(defun getalllayname ( / out )
(vlax-for x *LAYERS*
(setq out (cons (aboutName x) out))
)
(reverse out)
)
;;返回对象的名称
(defun aboutName ( obj )
(if (vlax-property-available-p obj 'Name)
(*aboutp* obj 'Name)
"<NONE_NAME>"
)
)
;;删除表中重复元素
(defun delsame( biao )
(if biao
(cons (car biao) (delsame (vl-remove (car biao) (cdr biao))))
)
)
;;提取参照图层的有效图层名称，需要express支持
(defun tiquczlayernm( laynm / m n )
(setq thestr laynm)
(while (setq n (acet-str-find "$" thestr))
(setq thestr (substr thestr (setq m (1+ n))))
)
thestr
)
(princ)
前面说的645个图层归并到132个的dwg大小是2.55M
程序运行时间大约10分钟
如果优化一下程序
改 foreach 为 repeat 100 多次运行
运行时间不知道是否能缩短一点 运行时发现缺少函数ACET-STR-FIND请楼主提供 正需要 图层合并程序，以上程序似乎未实现。
哪位有程序，望分享。 找了好久 这个速度太慢了. 这个当时应急做的程序
很low 图层归并其实仅仅是参照归并的一个方面
还有字体、线型、块名、标注等等
说起来还是有点复杂
后来有空做了全方位的归并程序
99%以上的归并完成率
速度方面也还可以
不过这种程序实际没啥大用
有底图没人会在绑定后的图上画图
没有底图往往是拿的其它设计院的图纸
这种情况在实际工作中其实还是少 还是有用的，期待分享 请教一次，文字样式和标注样式是否有类似的图层归并laymrg函数
页:
[1]
2