图纸合并源码--待改善

lengxiaxi · 发表于 2023-3-1 17:21

图纸合并，多个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: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") 
)

lengxiaxi · 发表于 2023-3-10 11:07

(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)
)

(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-2 14:29

本帖最后由 zhangcan0515 于 2023-3-3 19:40 编辑

lengxiaxi 发表于 2023-3-2 14:00
不是转换的问题，转换无非设置好映射，字体，线型，图层。那都容易。

是合并的问题

你单张图纸都没有处理好，你合并肯定问题多了，你用映射肯定也不行，我们这是重新新建的标注样式字体样式，替换过了原来SW到dwg这样合并后才不会出现你说的那种情况的。你不处理到合并就是图块冲突标注样式冲突，导致你每张标注字高发生变化。

lengxiaxi · 发表于 2023-3-3 19:05

zhangcan0515 发表于 2023-3-2 14:29
你单张图纸都没有处理好，你合并肯定问题多了，你用映射肯定也不行，我们这是重新新建的标注样式字体样 ...

感谢指教，看样子，像是时间戳添加到块名称，这样所有块就是唯一的名称。sw中如何设置，可否赐教？

aws · 发表于 2023-3-1 18:42

这是个值得研究的话题

zm880928 · 发表于 2023-3-2 11:10

全部分解了再导入呢

zhangcan0515 · 发表于 2023-3-2 13:31

这个问题已经解决了，，请看视频。

lengxiaxi · 发表于 2023-3-2 14:00

zhangcan0515 发表于 2023-3-2 13:31
这个问题已经解决了，，请看视频。

不是转换的问题，转换无非设置好映射，字体，线型，图层。那都容易。

是合并的问题

lxl217114 · 发表于 2023-3-2 16:20

谢谢分享，点赞占个楼

hzyhzjjzh · 发表于 2023-3-3 13:12

谢谢分享，

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

[讨论] 图纸合并源码--待改善

本帖子中包含更多资源