图纸合并源码--待改善
图纸合并，多个dwg合并在一个dwg里。现在三维软件众多，很多批量输出的dwg，都含有同名块，或同名标注样式
大部分的合并插件，合并后，会引起块冲突或者标注样式冲突，导致效果并不理想
以下为源码，不知道哪位大神写的，已查无实据。感谢前人的奉献！
此程序需要解决的问题：
1.标注样式冲突，导致即便执行sub2，标注的文字大小全部变为统一打大小了
应该保持原样才对（大图框原始标注文字大，小图框原始标注文字也小）
【希望加入合并前，随机rename块名，随机rename标注样式名称】
2.合并后，图形之间全部重叠了
应该设置为一定间距，或者用户指定间距
(defun c:XXX ()
;;插图到一起
(setvar "CMDECHO" 0)
(setq pf (getfiled "指定原文件路径中的一个图形文件:>" "*" "dwg" 8))
(setq path (vl-filename-directory pf))
(setq path (strcat path "\\"))
(setq aa (vl-directory-files path "*.dwg" 1))
(setq n (length aa))
(setq i 0
nn 0
)
(setq pp (nth i aa))
(initget "1 2")
(setq opt (getkword
"\n 1：按块插入 /2：解块插入 "
)
)
(if opt
(cond
((= opt "1") (sub1))
((= opt "2") (sub2))
)
)
(princ)
)
(defun sub1 ()
(prompt "\n")
(prompt "程序正在按块插入图幅，请等待...\n")
(while (/= pp nil)
(setq i (+ i 1))
(setq pp (strcat path pp))
(command "insert" pp "0,0" "1" "1" "")
(setq nn (+ nn 1))
(princ (strcat "第" (itoa nn) "幅" "图号为" pp " \r"))
(setq pp (nth i aa))
)
(command "zoom" "e" "zoom" "0.8x")
)
(defun sub2 ()
(prompt "\n")
(prompt "程序正在解块插入图幅，请等待...\n")
(while (/= pp nil)
(setq i (+ i 1))
(setq pp (strcat path pp))
(setq pp (strcat "*" pp))
(command "insert" pp "0,0" "1" "")
(setq nn (+ nn 1))
(princ (strcat "第" (itoa nn) "幅" "图号为" pp " \r"))
(setq pp (nth i aa))
(setq pp (nth i aa))
)
(command "zoom" "e" "zoom" "0.8x")
)
(defun c:hbtz (/ tzml filelst i x y pmax pmin zx ys dx dy cdy dwg fn fd)
(vl-load-com)
(defun browseforfolder (msg / shfolder path catchit)
(setq shfolder (vlax-invoke-method (vlax-create-object "Shell.Application")
'browseforfolder
(vlax-get-property
(vlax-get-acad-object)
'hwnd
) msg 1
)
catchit (vl-catch-all-apply '(lambda ()
(setq shfolder
(vlax-get-property shfolder
'self
)
path
(vlax-get-property shfolder
'path
)
)
)
)
)
(if (vl-catch-all-error-p catchit)
nil
path
)
)
(setq tzml (browseforfolder "选择文件路径"))
(if (/= (substr tzml (strlen tzml)) "\\")
(setq tzml (strcat tzml "\\"))
)
(setq filelst (vl-directory-files tzml "*.dwg" 1))
(setq filelst (acad_strlsort filelst)
i -1
x 0
y 0
cdy 0
)
(setq fn (getint "\n[每行文件数量]<1>:"))
(if (not fn)
(setq fn 1)
)
(setq fd (getreal "\n[文件间距]<100>:"))
(if (not fd)
(setq fd 100)
)
(setvar "osmode" 0)
(setvar "attreq" 0)
(setvar "cmdecho" 0)
(command "ucs" "")
(while (setq dwg (nth (setq i (1+ i))
filelst
)
)
(prompt (strcat "\n" dwg))
(command "insert" (strcat tzml dwg) (list 0 0) "" "" "")
(vla-getboundingbox (vlax-ename->vla-object (entlast)) 'mi 'ma)
(setq pmax (vlax-safearray->list ma)
pmin (vlax-safearray->list mi)
)
(setq zx (list (car pmin) (cadr pmin))
ys (list (car pmax) (cadr pmax))
)
(setq dwg (entlast))
(command "rectangle" pmin pmax)
(command "change" (entlast) "" "P" "C" "1" "")
(command "move" dwg (entlast) "" (list (car zx) (cadr ys))
(list x y)
)
(setq dy (- (cadr ys) (cadr zx))
dx (- (car ys) (car zx))
)
(if (> dy cdy)
(setq cdy dy)
)
(if (= (rem (1+ i) fn) 0)
(setq x 0
y (- y cdy fd)
cdy 0
)
(setq x (+ x dx fd))
)
)
(princ)
)
这段代码，如何加入(command "_explode" "all" "")，使得插入前，分解每一个图块和标注样式；最好是重命名块和标注样式（随机名字也可以） 本帖最后由 zhangcan0515 于 2023-3-3 19:40 编辑
lengxiaxi 发表于 2023-3-2 14:00
不是转换的问题，转换无非设置好映射，字体，线型，图层。那都容易。
是合并的问题
你单张图纸都没有处理好，你合并肯定问题多了，你用映射肯定也不行，我们这是重新新建的标注样式 字体样式，替换过了原来SW到dwg这样合并后才不会出现你说的那种情况的。你不处理到合并就是图块冲突 标注样式冲突，导致你每张标注字高发生变化。 zhangcan0515 发表于 2023-3-2 14:29
你单张图纸都没有处理好，你合并肯定问题多了，你用映射肯定也不行，我们这是重新新建的标注样式 字体样 ...
感谢指教，看样子，像是时间戳添加到块名称，这样所有块就是唯一的名称。sw中如何设置，可否赐教？ 这是个值得研究的话题 全部分解了再导入呢 这个问题已经解决了，，请看视频。
zhangcan0515 发表于 2023-3-2 13:31
这个问题已经解决了，，请看视频。
不是转换的问题，转换无非设置好映射，字体，线型，图层。那都容易。
是合并的问题 谢谢分享，点赞占个楼 谢谢分享，{:1_1:}
页:
[1]
2