（XD::Drag:Move）通用拖动移动函数（支持 改基点、对齐、缩放、左右翻、上下翻、...

XDSoft

1. (defun XD::Drag:Move (info   ss            basepoint          mode         /        _keys
   
2.                       an     an1    box           d1          d2         dynpt        kw
   
3.                       lastang            mat           mat1          p1         p2        pt
   
4.                       ptbase s1            s2           scl          ss2         yorn        ret
   
5.                      )
   
6.   (defun _keyword (kw)
   
7.     (defun _rcallback (dynpt)
   
8.       (if (not lastang)
   
9.         (setq lastang (angle p1 dynpt))
   
10.       )
    
11.       (setq an        (- (setq an1 (angle p1 dynpt)) lastang)
    
12.             mat        (xdrx-matrix-setrotation an '(0 0 1) p1)
    
13.       )
    
14.       (xdrx-entity-transform ss mat)
    
15.       (xd::text:adjust ss)
    
16.       (setq mat1 (xdrx-matrix-product mat mat1))
    
17.       (setq lastang an1)
    
18.     )
    
19.     (defun _micallback (dynpt)
    
20.       (xdrx-entity-delete ss2)
    
21.       (setq ss2 (xdrx-entity-copy ss t))
    
22.       (setq mat (xdrx-matrix-setmirror (list (trans p1 1 0) dynpt)))
    
23.       (xdrx-entity-transform ss2 mat)
    
24.       (xd::text:adjust ss2)
    
25.       (setq mat1 (xdrx-matrix-product mat mat1))
    
26.     )
    
27.     (defun _sclcallback        (dynpt)
    
28.       (xdrx-entity-delete ss2)
    
29.       (setq ss2 (xdrx-entity-copy ss t))
    
30.       (setq box (xdrx-points-ucs2wcs (xdrx-entity-box ss2)))
    
31.       (setq mat        (xdrx-matrix-setscale
    
32.                   (/ (distance dynpt (trans p1 1 0))
    
33.                      (distance (car box) (nth 3 box))
    
34.                   )
    
35.                   (trans p1 1 0)
    
36.                 )
    
37.       )
    
38.       (xdrx-entity-transform ss2 mat)
    
39.       (xd::text:adjust ss2)
    
40.       (setq mat1 (xdrx-matrix-product mat mat1))
    
41.     )
    
42.     (setq ptbase (xd::drag:getbasepoint))
    
43.     (cond
    
44.       ((= kw "T")
    
45.        (if (setq pt (getpoint "\n新的基点<退出>:"))
    
46.          (progn (xd::drag:setbasepoint (trans pt 1 0)))
    
47.        )
    
48.       )
    
49.       ((= kw "A")
    
50.        (setq mat (xdrx-matrix-setrotation (/ pi 2.0) '(0 0 1) p1))
    
51.        (xdrx-entity-transform ss mat)
    
52.       )
    
53.       ((= kw "R")
    
54.        (setq p1          (xd::drag:getbasepoint)
    
55.              mat1 (xdrx-matrix-identity 3)
    
56.        )
    
57.        (xdrx-pointmonitor "_rcallback")
    
58.        (if (not (setq p2 (getpoint p1 "\n旋转轴第二点<退出>:")))
    
59.          (progn
    
60.            (xdrx-entity-transform ss2 (xdrx-matrix-inverse mat1))
    
61.          )
    
62.        )
    
63.        (xdrx-pointmonitor)
    
64.        (xd::drag:setbasepoint (trans p1 1 0))
    
65.       )
    
66.       ((= kw "M")
    
67.        (setq mat1 (xdrx-matrix-identity 3))
    
68.        (if (and        (setq p1 (getpoint "\n镜像轴第一点<退出>:"))
    
69.                 (xdrx-pointmonitor "_micallback")
    
70.                 (setq p2 (getpoint p1 "\n镜像轴第二点<退出>:"))
    
71.            )
    
72.          (progn        (setq mat (xdrx-matrix-setmirror
    
73.                             (list (trans p1 1 0) (trans p2 1 0))
    
74.                           )
    
75.                 )
    
76.                 (xdrx-entity-delete ss2)
    
77.                 (xdrx-entity-transform ss mat)
    
78.                 (xd::text:adjust ss)
    
79.          )
    
80.          (progn        (xdrx-entity-transform ss (xdrx-matrix-inverse mat1))
    
81.          )
    
82.        )
    
83.        (xdrx-pointmonitor)
    
84.       )
    
85.       ((= kw "S")
    
86.        (setq mat
    
87.               (xdrx-matrix-setmirror
    
88.                 (list ptbase
    
89.                       (mapcar '+ ptbase (trans (getvar "ucsydir") 1 0 t))
    
90.                 )
    
91.               )
    
92.        )
    
93.        (xdrx-entity-transform ss mat)
    
94.        (xd::text:adjust ss)
    
95.       )
    
96.       ((= kw "D")
    
97.        (setq mat
    
98.               (xdrx-matrix-setmirror
    
99.                 (list ptbase
    
100.                       (mapcar '+ ptbase (trans (getvar "ucsxdir") 1 0 t))
     
101.                 )
     
102.               )
     
103.        )
     
104.        (xdrx-entity-transform ss mat)
     
105.        (xd::text:adjust ss)
     
106.       )
     
107.       ((= kw "L")
     
108.        (setq mat1 (xdrx-matrix-identity 3))
     
109.        (if (and        (setq p1 (getpoint "\n基点<退出>:"))
     
110.                 (xdrx-pointmonitor "_sclcallback")
     
111.                 (setq p2 (getpoint p1 "\n镜第二点<输入>:"))
     
112.            )
     
113.          (progn        (xdrx-entity-delete ss2)
     
114.                 (xdrx-entity-transform ss mat)
     
115.                 (xd::text:adjust ss)
     
116.          )
     
117.          (progn
     
118.            (if (setq scl (getreal "\n输入放大比例系数<退出>:"))
     
119.              (progn (setq mat (xdrx-matrix-setscale scl (trans p1 1 0)))
     
120.                     (xdrx-entity-transform ss mat)
     
121.              )
     
122.            )
     
123.          )
     
124.        )
     
125.        (xdrx-pointmonitor)
     
126.       )
     
127.       ((= kw "F")
     
128.        (if (and        (setq yorn (xdrx-yesorno "\n是否缩放:" 0))
     
129.                 (setq s1 (getpoint "\n对齐源轴第一点<退出>:"))
     
130.                 (setq s2 (getpoint s1 "\n源轴第二点<退出>:"))
     
131.                 (xdrx-grdraw 1 -1 s1 s2)
     
132.                 (setq d1 (getpoint "\n对齐目标轴第一点<退出>:"))
     
133.                 (setq d2 (getpoint d1 "\n对齐目标轴第二点<退出>:"))
     
134.            )
     
135.          (progn        (xdrx-entity-align
     
136.                   ss
     
137.                   ptbase
     
138.                   (mapcar '+
     
139.                           ptbase
     
140.                           (mapcar '- (trans s2 1 0) (trans s1 1 0))
     
141.                   )
     
142.                   (trans d1 1 0)
     
143.                   (trans d2 1 0)
     
144.                   (if (= yorn 1)
     
145.                     t
     
146.                     nil
     
147.                   )
     
148.                 )
     
149.          )
     
150.        )
     
151.       )
     
152.     )
     
153.     (setq ptbase (xd::drag:getbasepoint))
     
154.   )
     
155.   (if (not mode)
     
156.     (setq mode 7)
     
157.   )
     
158.   (if (not basepoint)
     
159.     (setq basepoint 5)
     
160.   )
     
161.   (if (= (type basepoint) 'INT)
     
162.     (progn (setq basepoint (abs basepoint))
     
163.            (if (or (< basepoint 1) (> basepoint 9))
     
164.              (setq basepoint 5)
     
165.            )
     
166.            (setq basepoint (xd::geom:get9pt ss basepoint))
     
167.     )
     
168.   )
     
169.   (setq        lastang        nil
     
170.         _keys nil
     
171.   )
     
172.   (if (not info)
     
173.     (setq info "\n插入点")
     
174.   )
     
175.   (setq info (strcat info "["))
     
176.   (setq        _keys (cons "T" _keys)
     
177.         info  (xdrx-prompt info "改基点(T)" t)
     
178.   )
     
179.   (if (= (rem 2 mode) 2)
     
180.     (setq _keys        (cons "F" _keys)
     
181.           info        (xdrx-prompt info "/对齐(F)" t)
     
182.     )
     
183.   )
     
184.   (if (= (rem 4 mode) 4)
     
185.     (setq _keys        (cons "A" _keys)
     
186.           info        (xdrx-prompt info "/转90度(A)" t)
     
187.     )
     
188.   )
     
189.   (if (= (rem 8 mode) 8)
     
190.     (setq _keys        (cons "S" _keys)
     
191.           info        (xdrx-prompt info "/左右翻(S)" t)
     
192.     )
     
193.   )
     
194.   (if (= (rem 16 mode) 16)
     
195.     (setq _keys        (cons "D" _keys)
     
196.           info        (xdrx-prompt info "/上下翻(D)" t)
     
197.     )
     
198.   )
     
199.   (if (= (rem 32 mode) 32)
     
200.     (setq _keys        (cons "R" _keys)
     
201.           info        (xdrx-prompt info "/改转角(R)" t)
     
202.     )
     
203.   )
     
204.   (if (= (rem 64 mode) 64)
     
205.     (setq _keys        (cons "M" _keys)
     
206.           info        (xdrx-prompt info "/镜像(M)" t)
     
207.     )
     
208.   )
     
209.   (if (= (rem 128 mode) 128)
     
210.     (setq _keys        (cons "L" _keys)
     
211.           info        (xdrx-prompt info "/缩放(L)" t)
     
212.     )
     
213.   )
     
214.   (setq _keys (xdrx-string-join _keys " "))
     
215.   (setq info (strcat info "]<退出>:"))
     
216.   (and (xd::drag:setbasepoint (trans basepoint 1 0))
     
217.        (xd::doc:setkeyword _keys)
     
218.        (xd::drag:callbacksetkeyword "_keyword")
     
219.        (setq ret (xd::drag:simplemove ss info (trans basepoint 1 0) t))
     
220.   )
     
221.   ret
     
222. )
     

(defun XD::Drag:Move (info   ss            basepoint          mode         /        _keys<br />                       an     an1    box           d1          d2         dynpt        kw<br />                       lastang            mat           mat1          p1         p2        pt<br />                       ptbase s1            s2           scl          ss2         yorn        ret<br />                      )<br />   (defun _keyword (kw)<br />     (defun _rcallback (dynpt)<br />       (if (not lastang)<br />         (setq lastang (angle p1 dynpt))<br />       )<br />       (setq an        (- (setq an1 (angle p1 dynpt)) lastang)<br />             mat        (xdrx-matrix-setrotation an '(0 0 1) p1)<br />       )<br />       (xdrx-entity-transform ss mat)<br />       (xd::text:adjust ss)<br />       (setq mat1 (xdrx-matrix-product mat mat1))<br />       (setq lastang an1)<br />     )<br />     (defun _micallback (dynpt)<br />       (xdrx-entity-delete ss2)<br />       (setq ss2 (xdrx-entity-copy ss t))<br />       (setq mat (xdrx-matrix-setmirror (list (trans p1 1 0) dynpt)))<br />       (xdrx-entity-transform ss2 mat)<br />       (xd::text:adjust ss2)<br />       (setq mat1 (xdrx-matrix-product mat mat1))<br />     )<br />     (defun _sclcallback        (dynpt)<br />       (xdrx-entity-delete ss2)<br />       (setq ss2 (xdrx-entity-copy ss t))<br />       (setq box (xdrx-points-ucs2wcs (xdrx-entity-box ss2)))<br />       (setq mat        (xdrx-matrix-setscale<br />                   (/ (distance dynpt (trans p1 1 0))<br />                      (distance (car box) (nth 3 box))<br />                   )<br />                   (trans p1 1 0)<br />                 )<br />       )<br />       (xdrx-entity-transform ss2 mat)<br />       (xd::text:adjust ss2)<br />       (setq mat1 (xdrx-matrix-product mat mat1))<br />     )<br />     (setq ptbase (xd::drag:getbasepoint))<br />     (cond<br />       ((= kw "T")<br />        (if (setq pt (getpoint "\n新的基点<退出>:"))<br />          (progn (xd::drag:setbasepoint (trans pt 1 0)))<br />        )<br />       )<br />       ((= kw "A")<br />        (setq mat (xdrx-matrix-setrotation (/ pi 2.0) '(0 0 1) p1))<br />        (xdrx-entity-transform ss mat)<br />       )<br />       ((= kw "R")<br />        (setq p1          (xd::drag:getbasepoint)<br />              mat1 (xdrx-matrix-identity 3)<br />        )<br />        (xdrx-pointmonitor "_rcallback")<br />        (if (not (setq p2 (getpoint p1 "\n旋转轴第二点<退出>:")))<br />          (progn<br />            (xdrx-entity-transform ss2 (xdrx-matrix-inverse mat1))<br />          )<br />        )<br />        (xdrx-pointmonitor)<br />        (xd::drag:setbasepoint (trans p1 1 0))<br />       )<br />       ((= kw "M")<br />        (setq mat1 (xdrx-matrix-identity 3))<br />        (if (and        (setq p1 (getpoint "\n镜像轴第一点<退出>:"))<br />                 (xdrx-pointmonitor "_micallback")<br />                 (setq p2 (getpoint p1 "\n镜像轴第二点<退出>:"))<br />            )<br />          (progn        (setq mat (xdrx-matrix-setmirror<br />                             (list (trans p1 1 0) (trans p2 1 0))<br />                           )<br />                 )<br />                 (xdrx-entity-delete ss2)<br />                 (xdrx-entity-transform ss mat)<br />                 (xd::text:adjust ss)<br />          )<br />          (progn        (xdrx-entity-transform ss (xdrx-matrix-inverse mat1))<br />          )<br />        )<br />        (xdrx-pointmonitor)<br />       )<br />       ((= kw "S")<br />        (setq mat<br />               (xdrx-matrix-setmirror<br />                 (list ptbase<br />                       (mapcar '+ ptbase (trans (getvar "ucsydir") 1 0 t))<br />                 )<br />               )<br />        )<br />        (xdrx-entity-transform ss mat)<br />        (xd::text:adjust ss)<br />       )<br />       ((= kw "D")<br />        (setq mat<br />               (xdrx-matrix-setmirror<br />                 (list ptbase<br />                       (mapcar '+ ptbase (trans (getvar "ucsxdir") 1 0 t))<br />                 )<br />               )<br />        )<br />        (xdrx-entity-transform ss mat)<br />        (xd::text:adjust ss)<br />       )<br />       ((= kw "L")<br />        (setq mat1 (xdrx-matrix-identity 3))<br />        (if (and        (setq p1 (getpoint "\n基点<退出>:"))<br />                 (xdrx-pointmonitor "_sclcallback")<br />                 (setq p2 (getpoint p1 "\n镜第二点<输入>:"))<br />            )<br />          (progn        (xdrx-entity-delete ss2)<br />                 (xdrx-entity-transform ss mat)<br />                 (xd::text:adjust ss)<br />          )<br />          (progn<br />            (if (setq scl (getreal "\n输入放大比例系数<退出>:"))<br />              (progn (setq mat (xdrx-matrix-setscale scl (trans p1 1 0)))<br />                     (xdrx-entity-transform ss mat)<br />              )<br />            )<br />          )<br />        )<br />        (xdrx-pointmonitor)<br />       )<br />       ((= kw "F")<br />        (if (and        (setq yorn (xdrx-yesorno "\n是否缩放:" 0))<br />                 (setq s1 (getpoint "\n对齐源轴第一点<退出>:"))<br />                 (setq s2 (getpoint s1 "\n源轴第二点<退出>:"))<br />                 (xdrx-grdraw 1 -1 s1 s2)<br />                 (setq d1 (getpoint "\n对齐目标轴第一点<退出>:"))<br />                 (setq d2 (getpoint d1 "\n对齐目标轴第二点<退出>:"))<br />            )<br />          (progn        (xdrx-entity-align<br />                   ss<br />                   ptbase<br />                   (mapcar '+<br />                           ptbase<br />                           (mapcar '- (trans s2 1 0) (trans s1 1 0))<br />                   )<br />                   (trans d1 1 0)<br />                   (trans d2 1 0)<br />                   (if (= yorn 1)<br />                     t<br />                     nil<br />                   )<br />                 )<br />          )<br />        )<br />       )<br />     )<br />     (setq ptbase (xd::drag:getbasepoint))<br />   )<br />   (if (not mode)<br />     (setq mode 7)<br />   )<br />   (if (not basepoint)<br />     (setq basepoint 5)<br />   )<br />   (if (= (type basepoint) 'INT)<br />     (progn (setq basepoint (abs basepoint))<br />            (if (or (< basepoint 1) (> basepoint 9))<br />              (setq basepoint 5)<br />            )<br />            (setq basepoint (xd::geom:get9pt ss basepoint))<br />     )<br />   )<br />   (setq        lastang        nil<br />         _keys nil<br />   )<br />   (if (not info)<br />     (setq info "\n插入点")<br />   )<br />   (setq info (strcat info "["))<br />   (setq        _keys (cons "T" _keys)<br />         info  (xdrx-prompt info "改基点(T)" t)<br />   )<br />   (if (= (rem 2 mode) 2)<br />     (setq _keys        (cons "F" _keys)<br />           info        (xdrx-prompt info "/对齐(F)" t)<br />     )<br />   )<br />   (if (= (rem 4 mode) 4)<br />     (setq _keys        (cons "A" _keys)<br />           info        (xdrx-prompt info "/转90度(A)" t)<br />     )<br />   )<br />   (if (= (rem 8 mode) 8)<br />     (setq _keys        (cons "S" _keys)<br />           info        (xdrx-prompt info "/左右翻(S)" t)<br />     )<br />   )<br />   (if (= (rem 16 mode) 16)<br />     (setq _keys        (cons "D" _keys)<br />           info        (xdrx-prompt info "/上下翻(D)" t)<br />     )<br />   )<br />   (if (= (rem 32 mode) 32)<br />     (setq _keys        (cons "R" _keys)<br />           info        (xdrx-prompt info "/改转角(R)" t)<br />     )<br />   )<br />   (if (= (rem 64 mode) 64)<br />     (setq _keys        (cons "M" _keys)<br />           info        (xdrx-prompt info "/镜像(M)" t)<br />     )<br />   )<br />   (if (= (rem 128 mode) 128)<br />     (setq _keys        (cons "L" _keys)<br />           info        (xdrx-prompt info "/缩放(L)" t)<br />     )<br />   )<br />   (setq _keys (xdrx-string-join _keys " "))<br />   (setq info (strcat info "]<退出>:"))<br />   (and (xd::drag:setbasepoint (trans basepoint 1 0))<br />        (xd::doc:setkeyword _keys)<br />        (xd::drag:callbacksetkeyword "_keyword")<br />        (setq ret (xd::drag:simplemove ss info (trans basepoint 1 0) t))<br />   )<br />   ret<br /> )<br />

dyjwyqz5221

非常好用的函数，功能齐全，值得拥有！

凌乱的核桃仁

很好的资料，感谢分享

ko05050

学习学习           

sevenhaj

感谢感谢，

striver

非常棒的通用拖动移动函数，很多地方都用得到，需要好好学习下。