简单的一个对图工具

雨的节奏

2. (defun c:gsauditing (/ vps oldverp x pt temppt code oldverp vsize ocpt opt whs vp vpindex ovpcpt vpcpt)
   
3. (setq vps (vports))
   
4. (if (= 1 (length vps)) (progn (vl-cmdf "-vports" "si"  "-vports" "2" "v") (setvar "cvport" (car (last (setq vps (vports)))))))
   
5. ;;此时一定是有多视口的
   
6. (if (null vpsandptlist)
   
7. (progn
   
8. (setq vpsandptlist ())
   
9. (setq oldverp (getvar "cvport"))
   
10.   (foreach x vps
    
11.        ;;得到视口名和点表
    
12.      (setvar "cvport" (car x))
    
13.      (setq pt (getpoint "\n请指定当前激活视口的参考原点"))
    
14.        (if (null pt) (vl-exit-with-value ""))
    
15.      (setq vpsandptlist (cons (cons (car x) pt) vpsandptlist))
    
16.     )
    
17.   (setvar "cvport" oldverp)
    
18.   )
    
19. )
    
20. (princ "\n输入S可以设置对比参考点")
    
21. ;;这个时候得到了视口名与坐标点的数据，来注册一个事件
    
22. (setq temppt (getvar 'ViewCtr))
    
23. (while (and
    
24.            (setq code (grread T 8))
    
25.            (/= 32 (car code))
    
26.            (/= 25 (car code))
    
27.            (/= 3 (car code))
    
28.        )
    
29.        (if (and (= 2 (car code)) (or (= 83 (cadr code)) (= 115 (cadr code))))
    
30.           (progn
    
31.         (setq vpsandptlist ())
    
32.               (setq oldverp (getvar "cvport"))
    
33.               (foreach x vps
    
34.                ;;得到视口名和点表
    
35.                (setvar "cvport" (car x))
    
36.                (setq pt (getpoint "\n请指定当前激活视口的参考原点"))
    
37.                  (if (null pt) (vl-exit-with-value ""))
    
38.                (setq vpsandptlist (cons (cons (car x) pt) vpsandptlist))
    
39.                   )
    
40.              (setvar "cvport" oldverp)
    
41.         
    
42.         )
    
43.        )
    
44.          (setq oldverp (getvar "cvport")
    
45.                    vsize (getvar "viewsize")
    
46.            ocpt (getvar 'ViewCtr)
    
47.            opt (cdr (assoc oldverp vpsandptlist))
    
48.            whs (mapcar '- ocpt opt)
    
49.            )
    
50.        (if (null (equal temppt ocpt))
    
51.            (progn
    
52.             (foreach vp vps
    
53.                 (if (null (equal (car vp) oldverp))
    
54.                 (progn
    
55.               (setq vpindex (car vp))
    
56.               (setvar "cvport" vpindex)
    
57.               (setq ovpcpt (cdr (assoc vpindex vpsandptlist))
    
58.                     vpcpt (mapcar '+ ovpcpt whs)
    
59.                 )
    
60.               (vla-ZoomCenter (vlax-get-acad-object) (vlax-3d-point vpcpt) vsize)
    
61.               
    
62.               
    
63.                )
    
64.              )
    
65.           )
    
66.           ;;把对比值改成当前值
    
67.           (setvar "cvport" oldverp)
    
68.           (setq temppt ocpt)
    
69.          )
    
70.       )
    
71.                
    
72.        )
    
73.   
    
74.   (princ "\n完成对比")
    
75.   (prin1)
    
76. )

(defun c:gsauditing (/ vps oldverp x pt temppt code oldverp vsize ocpt opt whs vp vpindex ovpcpt vpcpt)<br /> (setq vps (vports))<br /> (if (= 1 (length vps)) (progn (vl-cmdf "-vports" "si"  "-vports" "2" "v") (setvar "cvport" (car (last (setq vps (vports)))))))<br /> ;;此时一定是有多视口的<br /> (if (null vpsandptlist)<br /> (progn<br /> (setq vpsandptlist ())<br /> (setq oldverp (getvar "cvport"))<br />   (foreach x vps<br />        ;;得到视口名和点表<br />      (setvar "cvport" (car x))<br />      (setq pt (getpoint "\n请指定当前激活视口的参考原点"))<br />        (if (null pt) (vl-exit-with-value ""))<br />      (setq vpsandptlist (cons (cons (car x) pt) vpsandptlist))<br />     )<br />   (setvar "cvport" oldverp)<br />   )<br /> )<br /> (princ "\n输入S可以设置对比参考点")<br /> ;;这个时候得到了视口名与坐标点的数据，来注册一个事件<br /> (setq temppt (getvar 'ViewCtr))<br /> (while (and<br />            (setq code (grread T 8))<br />            (/= 32 (car code))<br />            (/= 25 (car code))<br />            (/= 3 (car code))<br />        )<br />        (if (and (= 2 (car code)) (or (= 83 (cadr code)) (= 115 (cadr code))))<br />           (progn<br />         (setq vpsandptlist ())<br />               (setq oldverp (getvar "cvport"))<br />               (foreach x vps<br />                ;;得到视口名和点表<br />                (setvar "cvport" (car x))<br />                (setq pt (getpoint "\n请指定当前激活视口的参考原点"))<br />                  (if (null pt) (vl-exit-with-value ""))<br />                (setq vpsandptlist (cons (cons (car x) pt) vpsandptlist))<br />                   )<br />              (setvar "cvport" oldverp)<br />         <br />         )<br />        )<br />          (setq oldverp (getvar "cvport")<br />                    vsize (getvar "viewsize")<br />            ocpt (getvar 'ViewCtr)<br />            opt (cdr (assoc oldverp vpsandptlist))<br />            whs (mapcar '- ocpt opt)<br />            )<br />        (if (null (equal temppt ocpt))<br />            (progn<br />             (foreach vp vps<br />                 (if (null (equal (car vp) oldverp))<br />                 (progn<br />               (setq vpindex (car vp))<br />               (setvar "cvport" vpindex)<br />               (setq ovpcpt (cdr (assoc vpindex vpsandptlist))<br />                     vpcpt (mapcar '+ ovpcpt whs)<br />                 )<br />               (vla-ZoomCenter (vlax-get-acad-object) (vlax-3d-point vpcpt) vsize)<br />               <br />               <br />                )<br />              )<br />           )<br />           ;;把对比值改成当前值<br />           (setvar "cvport" oldverp)<br />           (setq temppt ocpt)<br />          )<br />       )<br />                 <br />        )<br />   <br />   (princ "\n完成对比")<br />   (prin1)<br /> )

注意事项：
  1、只在当前图对比
  2、对比点只设置一次，后面要再设置，输入s即可
  3、随便拿去用，也不用注明出处，反正我也是在论坛找别人的东西参考着写的

水洗可口可乐

问一下，不可以同一窗口，用重叠图形来对图吗？修改/不同处 亮显？

panliang9

cj52000 发表于 2023-10-14 19:56
大师，对图的中途好像不能进行操作，比如刷新，如要继续，再输入一遍命令是吧

楼主的这个程序已经很好了，如果你想中途有操作，必须使用
http://bbs.mjtd.com/forum.php?mo ... 4%CD%BC%C9%F1%C6%F7

树櫴希德

cj52000 发表于 2023-10-14 19:56
大师，对图的中途好像不能进行操作，比如刷新，如要继续，再输入一遍命令是吧

请问大神 你的程序是两个DWG图形对图还是一个DWG里面对图

菜卷鱼

CAD2020-2024自带了对图功能，别的版本不知道

https://help.autodesk.com/view/A ... A-9176-A8AE24CDFBC7
视频的1分34秒开始有介绍

yoyoho

谢谢! 雨的节奏 分享学习!!!!!

664571221

大哥你那个侧边栏是自己开发的嘛

cj52000

大师，对图的中途好像不能进行操作，比如刷新，如要继续，再输入一遍命令是吧

菜鸟初来乍到

感谢楼主分享

hzyhzjjzh

感谢楼主分享

czb203

感谢楼主分享