【DynamicLisp的高级应用】-- 对图神器(更新至2013.08.15)

highflybir · 发表于 2013-7-31 23:30

本帖最后由 highflybir 于 2013-8-22 00:45 编辑

【DynamicLisp的高级应用】-- 对图神器

画图的时候，我们常常遇到要比较两个图纸的不同之处。
这时候，我们可以用
方法1：把要比较的图插入进来或者外部参照近来，然后可能稍微改变一下颜色。这样就可以检查一下有哪些不同。
方法2：两张图纸并排窗口，不时用放大缩小等命令，在两张图纸之间进行。
方法1的优点是视窗较大。但缺点是如果图形复杂了，会让人眼花缭乱。虽说高版本的CAD可以对参照图纸进行透明之类的调整，但不适合低版本。
方法2的的优点是可以不更改图纸内容。缺点是并排窗口会使得检测窗口较小，而且频繁在两个窗口之间进行放大缩小等命令，
效率不高。

针对方法2的缺点，我利用我以前的程序DynamicLisp中的钩子函数，编写了一个程序，使得在对图时候能做到两个图形的缩放比例同步变化。

用法：并排两个要比较的图纸，两张图纸都加载此程序。在原图中输入命令: tt，然后激活要比较的图，再回到原图。那么，你就可以看到效果了。
在原图中的视窗的任何比例缩放或平移变换，都会在要比较的图中同步出来。

另外，我同时用ARX编写了一个命令是：CompareDwgs,嫌命令长的可以修改：
因为这个是一个C:开头lisp函数C: CompareDwgs,所以用户可以自己定义：譬如 (defun c:dtz () (C:CompareDwgs) (princ))
ARX的命令更快，错误更少。

如果想要停止比较，用remhook命令停止同步。
如果想要切换原图和对比图之间的关系，只需要在对比图上输入命令，然后在原图上激活，再回到对比图。
输入命令的为原图，激活的另一张图为对比图。

因为对图的基点是依据UCS的原点来进行的，所以想要进行基点对准的，只需要进行一下UCS的原点设置使得它们对准就可以。

另外附件的arx文件加载需要依据你的CAD版本和操作系统进行。
请看如下对应关系：

32位CAD:
DynamicLisp.R15.x32.arx ---  AutoCAD 2000-2002
DynamicLisp.R16.x32.arx ---  AutoCAD 2004-2006
DynamicLisp.R17.x32.arx ---  AutoCAD 2007-2009       32位
DynamicLisp.R18.x32.arx ---  AutoCAD 2010-2012       32位
DynamicLisp.R19.x32.arx ---  AutoCAD 2013-2014       32位

64位CAD:
DynamicLisp.R17.x64.arx ---  AutoCAD 2007-2009       64位
DynamicLisp.R18.x64.arx ---  AutoCAD 2010-2012       64位
DynamicLisp.R19.x64.arx ---  AutoCAD 2013-2014       64位
如有不能加载的版本，请告诉我。

建议用户使用arx命令 comparedwgs较好，无需使用lisp.
=============================================
2013.08.15更新, 新的特性如下：1、可以同步多个视图了。
2、不再闪屏。
3、可以直接用对话框设置好要同步的视图。
4、增加开关，随时关闭，随时打开，也可以随时设置同步的视图。
5、可以互动了。即4楼说的效果。

以下是LISP程序代码：

(vl-load-com)
;;;对比图纸
(defun c:tt (/ DOC1 DOC2 HWND1 HWND2 OLDVIEWCTRL OLDVIEWSIZE DOCS BaseP1)
(setq docs (vla-get-documents (vlax-get-acad-object)))
(if (> (vla-get-count docs) 1)
(progn
(setq doc1 (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq hwnd1 (vla-get-hwnd doc1))
(vl-bb-set 'doc1 doc1)
(vl-bb-set 'hwnd1 hwnd1)
(setq oldViewCtrl (getvar 'ViewCtr))
(setq oldViewSize (getvar 'ViewSize))
(vl-bb-set 'oldViewCtrl oldViewCtrl)
(vl-bb-set 'oldViewSize oldViewSize)
(prompt "\n请激活另外一文档以完成对图.")
(C:DocReactor)
(C:hook)
)
)
)
;;;回调函数
(defun HookCallback (hwnd message wParam lParam time Pos / *APP HWND1 OLDVIEWCTRL OLDVIEWSIZE newViewCtrl newViewSize)
(setq newViewCtrl (getvar 'ViewCtr))
(setq newViewSize (getvar 'ViewSize))
(setq oldViewCtrl (vl-bb-ref 'oldViewCtrl))
(setq oldViewSize (vl-bb-ref 'oldViewSize))
(setq *APP (vlax-get-acad-object))
(setq hwnd1 (vl-bb-ref 'hwnd1))
(if (and
(vl-bb-ref 'hwnd2)
(= (vla-get-hwnd (vla-get-ActiveDocument *APP)) hwnd1)
(or (not (equal newViewCtrl oldViewCtrl 1e-8))
(not (equal NewViewSize oldViewSize 1e-8))
)
)
(progn
(vl-bb-set 'newViewCtrl newViewCtrl)
(vl-bb-set 'newViewSize newViewSize)
(vla-SendCommand (vl-bb-ref 'doc2) "zoom C (vl-bb-ref 'newViewCtrl) (vl-bb-ref 'newViewSize) ")
(vla-Activate (vl-bb-ref 'doc1))
(setq oldViewCtrl NewViewCtrl)
(setq oldViewSize NewViewSize)
(vl-bb-set 'oldViewCtrl oldViewCtrl)
(vl-bb-set 'oldViewSize oldViewSize)
)
)
)
;;;钩子
(defun c:hook()
(HFB_removeHook)
(HFB_RegisterHook "HookCallback")
(princ)
)
;;;移除钩子
(defun C:RemHook()
(HFB_removeHook)
)
;;;文档已激活
(defun DocBecameCurrent (ReacObj Reacdata / doc2 hwnd2)
(setq doc2 (car reacdata))
(setq hwnd2 (vla-get-hwnd doc2))
(if (/= (vl-bb-ref 'hwnd1) hwnd2)
(progn
(vl-bb-set 'hwnd2 hwnd2)
(vl-bb-set 'Doc2 doc2)
)
)
)
;;;文档将激活
(defun DocToBeActivated (ReacObj Reacdata)
(vla-get-name (car reacdata))
)
;;;文档将关闭
(defun DocToBeDestroyed (ReacObj Reacdata / hwnd1 hwnd2 hwnd)
(setq hwnd1 (vl-bb-ref 'hwnd1))
(setq hwnd2 (vl-bb-ref 'hwnd2))
(setq hwnd (vla-get-hwnd (car reacdata)))
(if (or (= hwnd hwnd1) (= hwnd hwnd2))
(progn
(HFB_removehook)
(if *DocReactor*
(progn
(vlr-remove *DocReactor*)
(setq *DocReactor* nil)
)
)
)
)
)
;;;文档反应器
(defun c:DocReactor (/)
(if (null *DocReactor*)
(progn
(setq *DocReactor*
(VLR-DocManager-Reactor
nil
'(
(:vlr-documentBecameCurrent . DocBecameCurrent)
(:vlr-documentToBeActivated . DocToBeActivated)
(:VLR-documentToBeDestroyed . DocToBeDestroyed)
)
)
)
(vlr-set-notification *DocReactor* 'all-documents)
)
)
)
(vl-acad-defun 'vl-acad-defun)
(vl-acad-defun 'HookCallback)
(princ "\n命令是: TT")
(princ)

(vl-load-com) 
;;;对比图纸 
(defun c:tt (/ DOC1 DOC2 HWND1 HWND2 OLDVIEWCTRL OLDVIEWSIZE DOCS BaseP1) 
  (setq docs (vla-get-documents (vlax-get-acad-object))) 
  (if (> (vla-get-count docs) 1) 
    (progn 
      (setq doc1 (vla-get-ActiveDocument (vlax-get-acad-object))) 
      (setq hwnd1 (vla-get-hwnd doc1)) 
      (vl-bb-set 'doc1 doc1) 
      (vl-bb-set 'hwnd1 hwnd1) 
      (setq oldViewCtrl (getvar 'ViewCtr)) 
      (setq oldViewSize (getvar 'ViewSize)) 
      (vl-bb-set 'oldViewCtrl oldViewCtrl) 
      (vl-bb-set 'oldViewSize oldViewSize) 
      (prompt "\n请激活另外一文档以完成对图.") 
      (C:DocReactor) 
      (C:hook) 
    ) 
  ) 
) 
 
;;;回调函数 
(defun HookCallback (hwnd message wParam lParam time Pos / *APP HWND1 OLDVIEWCTRL OLDVIEWSIZE newViewCtrl newViewSize) 
  (setq newViewCtrl (getvar 'ViewCtr)) 
  (setq newViewSize (getvar 'ViewSize)) 
  (setq oldViewCtrl (vl-bb-ref 'oldViewCtrl)) 
  (setq oldViewSize (vl-bb-ref 'oldViewSize)) 
  (setq *APP (vlax-get-acad-object)) 
  (setq hwnd1 (vl-bb-ref 'hwnd1)) 
  (if (and 
        (vl-bb-ref 'hwnd2) 
        (= (vla-get-hwnd (vla-get-ActiveDocument *APP)) hwnd1) 
        (or (not (equal newViewCtrl oldViewCtrl 1e-8)) 
            (not (equal NewViewSize oldViewSize 1e-8)) 
        ) 
      ) 
    (progn 
      (vl-bb-set 'newViewCtrl newViewCtrl) 
      (vl-bb-set 'newViewSize newViewSize) 
      (vla-SendCommand (vl-bb-ref 'doc2) "zoom C (vl-bb-ref 'newViewCtrl) (vl-bb-ref 'newViewSize) ") 
      (vla-Activate (vl-bb-ref 'doc1)) 
      (setq oldViewCtrl NewViewCtrl) 
      (setq oldViewSize NewViewSize) 
      (vl-bb-set 'oldViewCtrl oldViewCtrl) 
      (vl-bb-set 'oldViewSize oldViewSize) 
    ) 
  ) 
) 
 
;;;钩子 
(defun c:hook() 
  (HFB_removeHook) 
  (HFB_RegisterHook "HookCallback") 
  (princ) 
) 
 
;;;移除钩子 
(defun C:RemHook() 
  (HFB_removeHook) 
) 
 
;;;文档已激活 
(defun DocBecameCurrent (ReacObj Reacdata / doc2 hwnd2) 
  (setq doc2 (car reacdata)) 
  (setq hwnd2 (vla-get-hwnd doc2)) 
  (if (/= (vl-bb-ref 'hwnd1) hwnd2) 
    (progn 
      (vl-bb-set 'hwnd2 hwnd2) 
      (vl-bb-set 'Doc2 doc2) 
    ) 
  ) 
) 
 
;;;文档将激活 
(defun DocToBeActivated (ReacObj Reacdata) 
  (vla-get-name (car reacdata)) 
) 
 
;;;文档将关闭 
(defun DocToBeDestroyed (ReacObj Reacdata / hwnd1 hwnd2 hwnd) 
  (setq hwnd1 (vl-bb-ref 'hwnd1)) 
  (setq hwnd2 (vl-bb-ref 'hwnd2)) 
  (setq hwnd (vla-get-hwnd (car reacdata))) 
  (if (or (= hwnd hwnd1) (= hwnd hwnd2)) 
    (progn 
      (HFB_removehook) 
      (if *DocReactor* 
        (progn 
          (vlr-remove *DocReactor*) 
          (setq *DocReactor* nil) 
        ) 
      ) 
    ) 
  ) 
) 
 
;;;文档反应器 
(defun c:DocReactor (/) 
  (if (null *DocReactor*) 
    (progn 
      (setq *DocReactor* 
             (VLR-DocManager-Reactor 
               nil 
               '( 
                 (:vlr-documentBecameCurrent . DocBecameCurrent) 
                 (:vlr-documentToBeActivated . DocToBeActivated) 
                 (:VLR-documentToBeDestroyed . DocToBeDestroyed) 
                ) 
             ) 
      ) 
      (vlr-set-notification *DocReactor* 'all-documents) 
    ) 
  ) 
) 
 
(vl-acad-defun 'vl-acad-defun) 
(vl-acad-defun 'HookCallback) 
(princ "\n命令是: TT") 
(princ)

附件见如下：

相关DynamicLisp的介绍请见：
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=90447&page=1&extra=#pid604291

dwg001 · 发表于 2013-8-11 11:46

本帖最后由 dwg001 于 2013-8-11 12:18 编辑

楼主强大，顶一个！
网上有几款类似的软件 overcad dwg compare、 compareDWG 2007、 VHCompare，基本操作都是将原图和对比图自动排列在同一屏幕中（可自行定义为上下或左右方式）；二副图有变化处直接变色（删除为红色、修改为黄色、增加为绿色）、没有变化处灰度化，使肉眼对比量最小化，感觉比较直观；另外自动建立一个比较结果文件夹，把变色后的原图和对比图放入进去，可直接用cad打开查看或再编辑，很是人性化。
这些可否借鉴？大伙都在期待着H版。

gdslqs · 发表于 2018-4-14 17:33

lm344437673 发表于 2013-10-4 02:13
这个很棒，对不一下CompareView，速度比CompareView快。
遇到三个问题：1.对比图纸时十字光标会出现另一个 ...

请问下你上传这个怎么用？命令是啥？

20060510412 · 发表于 2022-9-28 23:22

p-3-ianlcc 发表于 2022-9-28 12:29
大大，请教一下
arx有没有更新的版本呢？
可以支持到2014～2020的版本吗？

之前楼主分享过源代码，可惜后来又撤销了。

啵浪鼓 · 发表于 2013-7-31 23:35

本帖最后由啵浪鼓于 2013-8-1 00:01 编辑

H版对新程序了,对图是件很麻烦头痛的事! 以前是单个图内通过变颜色重叠来查看,这种2个图档相互查看未曾听闻,先留个爪印!
感谢H版的辛苦付出!

AutoCAD2005加载的是: DynamicLisp.R16.x32.arx
初试了一下程序,个人感觉这样对图有点烦琐:
1,首先2个图要切换切来切去,有点麻烦
2,要对的2个图档ucs定在一个点,只是某一个图元的,其它图元不在同一个点时,还得另外重新定ucs,不然缩放后切换到另一图就飞天了
3,缩放时,屏幕一闪一闪的,眼花!
4,不知几何时,出了这些信息,就一直不消停了
输入比例或高度 <589.1404>: (vl-bb-ref 'newViewSize) 589.14
命令: ; 错误: Automation 错误。文档切换已禁用
; 错误: Automation 错误。文档切换已禁用
; 错误: Automation 错误。文档切换已禁用
; 错误: Automation 错误。文档切换已禁用
; 错误: Automation 错误。文档切换已禁用
; 错误: Automation 错误。文档切换已禁用

highflybir · 发表于 2013-8-1 00:01

啵浪鼓发表于 2013-7-31 23:35
对较是件很麻烦头痛的事!
H版对新程序了,先留个爪印!
感谢H版的辛苦付出!

可能这些问题，对高版本好些。
另外，用ARX的命令要好过LISP的命令。
对于基点问题暂时没别的办法，只有ucs对准原点。因为我这个程序考虑的是两个相差不大的图纸进行比较。

啵浪鼓 · 发表于 2013-8-1 00:11

现在是A图档支配B图档,如果也同时能支持B图档支配A图档,那就更给力了!

mj0000 · 发表于 2013-8-1 08:35

可以变色么，不同的地方用颜色亮显，相同的地方用灰色，退出恢复原色

mj0000 · 发表于 2013-8-1 08:38

汗，理解错了，这个应该就是个窗口同步功能吧，不同的地方还是需要人工核对的

Casa小宝 · 发表于 2013-8-1 09:05

太强大了这个！在纯lisp下应该实现不了

朽木大师 · 发表于 2013-8-1 22:23

留个足印，以备用

tianyi1230 · 发表于 2013-8-2 09:55

高飞鸟还是在高云端漫步啊，我辈仰望之。。。。。。。。。。。。。。

fl202 · 发表于 2013-8-2 11:02

我们通常的做法是两张图放一起，变颜色，看变化一目了然。

浩辰cad里有个图纸文档比较功能挺好的。

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

[【高飞鸟】] 【DynamicLisp的高级应用】-- 对图神器(更新至2013.08.15)

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

相关帖子

点评

评分

点评