点监视器通用拖动函数XD::Drag:GMove的具体应用代码（1）

newer

短短的代码，实现了 复杂的功能。

通用拖动函数见： http://bbs.xdcad.net/thread-704335-1-1.html

1. (defun c:tt()
   
2.    (defun _callback22(pt) ;;拖动中的回调处理函数
   
3.       (mapcar 'set '(p-1 p-2) (XD::Pnts:OrthoProject (list p1 p2) pt (mapcar '+ pt v1)))
   
4.       (setq ints (xdrx_curve_getinters (list p-1 p-2) e 3) ;;**裁剪向量和多边形的所有交点
   
5.             ints (mapcar 'cadr (xdrx_points_sortoncurve (list p1 p2) ints))
   
6.             ints (xd::list:dotPair ints)  ;;交点集排序后，两两组合
   
7.             intsdim (XD::Pnts:OrthoProject (list p-1) (car box1)(last box1)) ;;尺寸线的基线位置
   
8.       )
   
9.       (mapcar '(lambda(x)(xdrx_grdraw 2 0 (car x)(cadr x))) ints) ;;绘制裁剪后的**向量
   
10.       (xdrx_setpropertyvalue edim "xLINE2Point" (car intsdim))    ;;拖动生成尺寸标注
    
11.    )
    
12.    (if (setq e (xdrx_entsel "\n拾取封闭的多边形<退出>:" '((0 . "LWPOLYLINE")(-4 . "&=")(70 . 1))))
    
13.      (progn
    
14.         (setq inx (XD::Polyline:OnSegAt (car e) (cadr e))
    
15.               e (car e)
    
16.               p1 (xdrx_getpropertyvalue e "PointAt" inx)
    
17.               p1 (XD::Pnts:Setz p1 0.0)
    
18.               p2 (xdrx_getpropertyvalue e "PointAt" (1+ inx))
    
19.               p2 (XD::Pnts:Setz p2 0.0)
    
20.               pt1 (xdrx_midp p1 p2)
    
21.               v1 (xdrx_vector_normalize (mapcar '- p2 p1))
    
22.               v2 (xdrx_vector_perpvector v1)
    
23.               box (xdrx_entity_box e v1)
    
24.               box1 (xdrx_points_offset (/ (distance (car box)(cadr box)) 10.0) (xd::pnts:close box))
    
25.               box2 (xdrx_points_offset (/ (distance (car box)(cadr box)) 3.0) box1)
    
26.               pdim-1 (inters p1 p2 (car box1)(last box1) nil)
    
27.         )
    
28.         (setq edim (xdrx_dimension_makerotate pdim-1 pdim-1 (car box2) (+ (angle p1 p2) (/ pi 2.0))))
    
29.          (if (setq pt2 (XD::DRAG:GMOVE pt1 "\n边线的位置<退出>:" -1 v2  nil "_callback22")) ;;动态拖动
    
30.           (progn
    
31.              (xdrx_grdraw 1 1 pt1 pt1)
    
32.           )
    
33.         )           
    
34.      )
    
35.    )
    
36.    (princ)
    
37. )
    
38. 
    

(defun c:tt()<br />    (defun _callback22(pt) ;;拖动中的回调处理函数<br />       (mapcar 'set '(p-1 p-2) (XD::Pnts:OrthoProject (list p1 p2) pt (mapcar '+ pt v1)))<br />       (setq ints (xdrx_curve_getinters (list p-1 p-2) e 3) ;;**裁剪向量和多边形的所有交点<br />             ints (mapcar 'cadr (xdrx_points_sortoncurve (list p1 p2) ints))<br />             ints (xd::list:dotPair ints)  ;;交点集排序后，两两组合<br />             intsdim (XD::Pnts:OrthoProject (list p-1) (car box1)(last box1)) ;;尺寸线的基线位置<br />       )<br />       (mapcar '(lambda(x)(xdrx_grdraw 2 0 (car x)(cadr x))) ints) ;;绘制裁剪后的**向量<br />       (xdrx_setpropertyvalue edim "xLINE2Point" (car intsdim))    ;;拖动生成尺寸标注<br />    )<br />    (if (setq e (xdrx_entsel "\n拾取封闭的多边形<退出>:" '((0 . "LWPOLYLINE")(-4 . "&=")(70 . 1))))<br />      (progn<br />         (setq inx (XD::Polyline:OnSegAt (car e) (cadr e))<br />               e (car e)<br />               p1 (xdrx_getpropertyvalue e "PointAt" inx)<br />               p1 (XD::Pnts:Setz p1 0.0)<br />               p2 (xdrx_getpropertyvalue e "PointAt" (1+ inx))<br />               p2 (XD::Pnts:Setz p2 0.0)<br />               pt1 (xdrx_midp p1 p2)<br />               v1 (xdrx_vector_normalize (mapcar '- p2 p1))<br />               v2 (xdrx_vector_perpvector v1)<br />               box (xdrx_entity_box e v1)<br />               box1 (xdrx_points_offset (/ (distance (car box)(cadr box)) 10.0) (xd::pnts:close box))<br />               box2 (xdrx_points_offset (/ (distance (car box)(cadr box)) 3.0) box1)<br />               pdim-1 (inters p1 p2 (car box1)(last box1) nil)<br />         )<br />         (setq edim (xdrx_dimension_makerotate pdim-1 pdim-1 (car box2) (+ (angle p1 p2) (/ pi 2.0))))<br />          (if (setq pt2 (XD::DRAG:GMOVE pt1 "\n边线的位置<退出>:" -1 v2  nil "_callback22")) ;;动态拖动<br />           (progn<br />              (xdrx_grdraw 1 1 pt1 pt1)<br />           )<br />         )           <br />      )<br />    )<br />    (princ)<br /> )<br /> <br />

liuyj

试过拖动时没有演示的效果

newer

liuyj 发表于 2016-5-25 15:02
试过拖动时没有演示的效果

多段线要封闭，点直线段，并且上面的代码没考虑UCS，要在WCS下操作，再试试。还不行，把你的图形截图贴上来。

liuyj

这次可以了，多谢

newer

liuyj 发表于 2016-5-25 15:35
这次可以了，多谢

那你上次是什么原因？

liuyj

原因没找到，也是闭合的多边形，但标注不能随着拖动变化，也看不到平行于边的移动的线。重开cad后又试了一次，可以了