图形合并位置出错

nyistjz

附件是写的一个合并图形的文件的小程序，
单个文件并入时，是没有问题的，可以附在我指定的位置；
但是选择多个文件时，就会出现问题，无法定位，请朋友们帮忙看一下，能否对程序进行优化；
感谢 ！

xyp1964

nyistjz 发表于 2024-6-22 13:25
大佬，竖向排列是否可以？

我按您这个逻辑试了一个竖向排列，但没有成功。

1. (defun c:tt2 ()
   
2.   "竖向合并dwg"
   
3.   (setvar "cmdecho" 0)
   
4.   (if (null DTU-MultiSelectDialog)
   
5.     (command "netload"(findfile "DTU-MultiSelectDialog2013.dll"))
   
6.   )
   
7.   (setq ao  (vlax-get-acad-object)
   
8.         ad  (vla-get-activedocument ao)
   
9.         ms  (vla-get-modelspace ad)
   
10.         lst (DTU-MultiSelectDialog "请选择DWG文件" "*.DWG")
    
11.         pt0 (getpoint "\n起始点<退出>: ")
    
12.   )
    
13.   (setq i 0)
    
14.   (foreach l lst
    
15.     (setq i  (1+ i)
    
16.           pt (vlax-3D-point pt0)
    
17.           e1 (vla-InsertBlock ms pt l 1 1 1 0)
    
18.     )
    
19.     (vla-getboundingbox e1 'll 'ur)
    
20.     (setq p1 (vlax-safearray->list ll)
    
21.           p9 (vlax-safearray->list ur)
    
22.           dy (- (cadr p9) (cadr p1))
    
23.     )
    
24.     (vla-move e1 (vlax-3D-point p1) (vlax-3D-point pt0))
    
25.     (setq pt0 (polar pt0 (* pi 0.5) dy))
    
26.     (princ (strcat "\n>>>第" (itoa i) "张：" l "\n"))
    
27.   )
    
28.   (princ (strcat "\n>>>操作结束，共合并" (itoa i) "张图。"))
    
29.   (setvar "cmdecho" 1)
    
30.   (princ)
    
31. )

(defun c:tt2 ()<br />   "竖向合并dwg"<br />   (setvar "cmdecho" 0)<br />   (if (null DTU-MultiSelectDialog)<br />     (command "netload"(findfile "DTU-MultiSelectDialog2013.dll"))<br />   )<br />   (setq ao  (vlax-get-acad-object)<br />         ad  (vla-get-activedocument ao)<br />         ms  (vla-get-modelspace ad)<br />         lst (DTU-MultiSelectDialog "请选择DWG文件" "*.DWG")<br />         pt0 (getpoint "\n起始点<退出>: ")<br />   )<br />   (setq i 0)<br />   (foreach l lst<br />     (setq i  (1+ i)<br />           pt (vlax-3D-point pt0)<br />           e1 (vla-InsertBlock ms pt l 1 1 1 0)<br />     )<br />     (vla-getboundingbox e1 'll 'ur)<br />     (setq p1 (vlax-safearray->list ll)<br />           p9 (vlax-safearray->list ur)<br />           dy (- (cadr p9) (cadr p1))<br />     )<br />     (vla-move e1 (vlax-3D-point p1) (vlax-3D-point pt0))<br />     (setq pt0 (polar pt0 (* pi 0.5) dy))<br />     (princ (strcat "\n>>>第" (itoa i) "张：" l "\n"))<br />   )<br />   (princ (strcat "\n>>>操作结束，共合并" (itoa i) "张图。"))<br />   (setvar "cmdecho" 1)<br />   (princ)<br /> )

xyp1964

1. (defun c:tt ()
   
2.   (setvar "cmdecho" 0)
   
3.   (if (null DTU-MultiSelectDialog) (command "netload" (findfile "DTU-MultiSelectDialog2013.dll")))
   
4.   (setq ao (vlax-get-acad-object))
   
5.   (setq ad (vla-get-activedocument ao))
   
6.   (setq ms (vla-get-modelspace ad))
   
7.   (setq  lst (DTU-MultiSelectDialog "请选择DWG文件" "DWG文件(*.dwg)|*.DWG" ))
   
8.   (setq pt0 (getpoint "\n起始点<退出>: "))
   
9.   (setq i 0)
   
10.   (foreach l lst
    
11.     (setq i  (1+ i)
    
12.           pt (vlax-3D-point pt0)
    
13.           e1 (vla-InsertBlock ms pt l 1 1 1 0)
    
14.     )
    
15.     (vla-getboundingbox e1 'll 'ur)
    
16.     (setq p1 (vlax-safearray->list ll)
    
17.           p9 (vlax-safearray->list ur)
    
18.           dx (- (car p9) (car p1))
    
19.     )
    
20.     (vla-move e1 (vlax-3D-point p1) (vlax-3D-point pt0))
    
21.     (setq pt0 (polar pt0 0 dx))
    
22.     (princ (strcat "\n>>>第" (itoa i) "张：" l "\n"))
    
23.   )
    
24.   (princ (strcat "\n>>>操作结束，共合并" (itoa i) "张图。"))
    
25.   (setvar "cmdecho" 1)
    
26.   (princ)
    
27. )

(defun c:tt ()<br />   (setvar "cmdecho" 0)<br />   (if (null DTU-MultiSelectDialog) (command "netload" (findfile "DTU-MultiSelectDialog2013.dll")))<br />   (setq ao (vlax-get-acad-object))<br />   (setq ad (vla-get-activedocument ao))<br />   (setq ms (vla-get-modelspace ad))<br />   (setq  lst (DTU-MultiSelectDialog "请选择DWG文件" "DWG文件(*.dwg)|*.DWG" ))<br />   (setq pt0 (getpoint "\n起始点<退出>: "))<br />   (setq i 0)<br />   (foreach l lst<br />     (setq i  (1+ i)<br />           pt (vlax-3D-point pt0)<br />           e1 (vla-InsertBlock ms pt l 1 1 1 0)<br />     )<br />     (vla-getboundingbox e1 'll 'ur)<br />     (setq p1 (vlax-safearray->list ll)<br />           p9 (vlax-safearray->list ur)<br />           dx (- (car p9) (car p1))<br />     )<br />     (vla-move e1 (vlax-3D-point p1) (vlax-3D-point pt0))<br />     (setq pt0 (polar pt0 0 dx))<br />     (princ (strcat "\n>>>第" (itoa i) "张：" l "\n"))<br />   )<br />   (princ (strcat "\n>>>操作结束，共合并" (itoa i) "张图。"))<br />   (setvar "cmdecho" 1)<br />   (princ)<br /> )

nyistjz

xyp1964 发表于 2024-6-22 11:35

大佬，竖向排列是否可以？

我按您这个逻辑试了一个竖向排列，但没有成功。

cds15980954301

捕捉关了,试下

nyistjz

cds15980954301 发表于 2024-6-22 07:00
捕捉关了,试下

试过了，不是这个原因

muai2010

不能用吧，缺函数

nyistjz

muai2010 发表于 2024-6-22 09:44
不能用吧，缺函数

把附件中的NET文件加载一下就行了

nyistjz

xyp1964 发表于 2024-6-22 11:35

大神，请受我一拜！

XPG

感谢分享。