【飞鸟集】高仿Align命令

仲文玉

飞鸟的程序必须支持

海盗曹

支持高飞兄，学习了

hhh454

顶这个代码，确实太好用了，感谢楼主。

13579

做个演示吧

pimgu

研究一下下

自贡黄明儒

vlisp2012 发表于 2012-9-7 21:08
还是犀牛的模式好，先指定3个源点，再指定3个目标点。省得鼠标两边跑

【低仿Align命令】
;;为了表示对H版此贴的支持,写如下程序
;;为了你的鼠标不移来移去,同时符合Autocad的习惯
;;H版的程序牵涉到久被人遗忘的<线性代数>,头疼.本程序用的是土办法

1. ;;为了表示对H版此贴的支持,写如下程序
   
2. ;;为了你的鼠标不移来移去,同时符合Autocad的习惯
   
3. ;;H版的程序牵涉到久被人遗忘的<线性代数>,头疼.本程序用的是土办法
   
4. ;;written by 自贡黄明儒
   
5. ;;  移动+旋转+缩放,相当于Align,本命令用于二维绘图
   
6.   (defun HH:MSRotate (/ APP DOC P1 P2 P3 P4 REPLY SS)
   
7.     (setq app (vlax-get-acad-object))
   
8.     (setq doc (vla-get-ActiveDocument app))
   
9.     (vla-StartUndoMark doc)
   
10.     (and (setq ss (ssget))
    
11.   (setq p1 (getpoint "\n 指定第一个源点:"))
    
12.   (princ "\n 指定第一个目标点:")
    
13.   (command "_.move" ss "" p1 pause)
    
14.     )
    
15.     (setq p3 (getvar "LASTPOINT"))
    
16.     (and p1
    
17.   (setq p2 (getpoint "\n 指定第二个源点:"))
    
18.   (setq p4 (getpoint "\n 指定第二个目标点:"))
    
19.   (command "_.ROTATE" ss "" p3 "R" p3 p2 p4)
    
20.     )
    
21.     (initget "Yes No")
    
22.     (setq
    
23.       reply
    
24.        (GETKWORD "\n 是否基于对齐点缩放对象？[是(Y)/否(N)] <否>:")
    
25.     )
    
26.     (if (equal reply "Yes")
    
27.       (progn (setq p2 (mapcar '- p2 (mapcar '- p3 p1)))
    
28.       (setq p2 (/ (distance p3 p4) (distance p1 p2)))
    
29.       (command "_.scale" ss "" p3 p2)
    
30.       )
    
31.     )
    
32.     (vla-EndUndoMark doc)
    
33.     (vlax-release-object doc)
    
34.     (vlax-release-object app)
    
35.     (princ)
    
36.   )
    

;;为了表示对H版此贴的支持,写如下程序<br /> ;;为了你的鼠标不移来移去,同时符合Autocad的习惯<br /> ;;H版的程序牵涉到久被人遗忘的<线性代数>,头疼.本程序用的是土办法<br /> ;;written by 自贡黄明儒<br /> ;;  移动+旋转+缩放,相当于Align,本命令用于二维绘图<br />   (defun HH:MSRotate (/ APP DOC P1 P2 P3 P4 REPLY SS)<br />     (setq app (vlax-get-acad-object))<br />     (setq doc (vla-get-ActiveDocument app))<br />     (vla-StartUndoMark doc)<br />     (and (setq ss (ssget))<br />   (setq p1 (getpoint "\n 指定第一个源点:"))<br />   (princ "\n 指定第一个目标点:")<br />   (command "_.move" ss "" p1 pause)<br />     )<br />     (setq p3 (getvar "LASTPOINT"))<br />     (and p1<br />   (setq p2 (getpoint "\n 指定第二个源点:"))<br />   (setq p4 (getpoint "\n 指定第二个目标点:"))<br />   (command "_.ROTATE" ss "" p3 "R" p3 p2 p4)<br />     )<br />     (initget "Yes No")<br />     (setq<br />       reply<br />        (GETKWORD "\n 是否基于对齐点缩放对象？[是(Y)/否(N)] <否>:")<br />     )<br />     (if (equal reply "Yes")<br />       (progn (setq p2 (mapcar '- p2 (mapcar '- p3 p1)))<br />       (setq p2 (/ (distance p3 p4) (distance p1 p2)))<br />       (command "_.scale" ss "" p3 p2)<br />       )<br />     )<br />     (vla-EndUndoMark doc)<br />     (vlax-release-object doc)<br />     (vlax-release-object app)<br />     (princ)<br />   )<br />

gufeng

好程序必须要支持支持

vlisp2012

大儒，好样的，顶你！！！

preone

学习~~

自贡黄明儒

kwok 发表于 2012-9-7 23:02
赞同，cad把简单事弄复杂化了,,,,,,,,

;;;先选目标三个点,再点目标三个点,似乎解决了鼠标移来移去的问题,但
;;;使用起来不方便.Autocad设计的align的点取顺序,还是很道理的.
;;;自贡黄明儒:H版的这个程序,可以演绎出许多我们自己需要的程序

1. ;;;先选目标三个点,再点目标三个点,似乎解决了鼠标移来移去的问题,但
   
2. ;;;使用起来不方便.Autocad设计的align的点取顺序,还是很道理的.
   
3. ;;;自贡黄明儒:H版的这个程序,可以演绎出许多我们自己需要的程序
   
4. 
   
5. ;;;-----------------------------------------------------------;;
   
6. ;;; 三点维的平齐命令，山寨Express Tools的align                ;;
   
7. ;;; 命令:Align3d ，可自己修改                                 ;;
   
8. ;;; Author: Highflybird, Date:2012-8-6.                       ;;
   
9. ;;; All copyrights reserved.                                  ;;
   
10. ;;;-----------------------------------------------------------;;
    
11. (defun C:Align3d (/        sel   sP1   sP2          sP3        dP1   dP2   dP3          sclp
    
12.                   scl        mat0  mat1  mat2  mat        i     ent   obj          app
    
13.                   doc        pt
    
14.                  )
    
15.   (setvar "cmdecho" 0)
    
16.   (if (setq sel (ssget))
    
17.     (progn
    
18.       (initget 9)
    
19.       (setq sP1 (getpoint "\n 指定第一个源点:"))
    
20.       (initget 9)
    
21.       (princ "\n 指定第一个目标点:")
    
22.       (command "_.move" sel "" sP1 pause)
    
23.       (setq dP1 (getvar "lastpoint"))
    
24.       (setq pt (mapcar '- dP1 sP1))
    
25.       (initget 9)
    
26.       (setq sP2 (getpoint "\n 指定第二个源点:"))
    
27.       (initget 9)
    
28.       (setq dP2 (getpoint sP2 "\n 指定第二个目标点:"))
    
29.       (setq sP2 (mapcar '- sP2 pt))
    
30.       (initget 8)
    
31.       (setq sP3 (getpoint "\n 指定第三个源点或 <继续>:"))
    
32. 
    
33.       (if (null sP3)
    
34.         (progn
    
35.           (setq sP3 (Mat:Rotate90 sP2 sP1))
    
36.           (setq dP3 (Mat:Rotate90 dP2 dP1))
    
37.         )
    
38.         (progn
    
39.           (initget 9)
    
40.           (progn
    
41.             (setq dP3 (getpoint sP3 "\n 指定第三个目标点:"))
    
42.             (setq sP3 (mapcar '- sP3 pt))
    
43.           )
    
44.         )
    
45.       )
    
46.       (foreach x '(sP1 sP2 sP3 dP1 dP2 dP3)
    
47.         (set x (trans (eval x) 1 0))
    
48.       )
    
49.       (initget "Yes No")
    
50.       (setq sclp
    
51.              (getkword "\n 是否基于对齐点缩放对象？[是(Y)/否(N)] <否>:")
    
52.       )
    
53.       (command "_.move" sel "" dP1 sP1)
    
54.       (setq mat1 (Mat:Get3PMatrix sP1 sP2 sP3))
    
55.       (setq mat2 (Mat:Get3PMatrix dP1 dP2 dP3))
    
56.       (if (= "Yes" sclp)
    
57.         (setq scl  (/ (distance dP1 dP2) (distance sP2 sP1))
    
58.               mat0 (list (list scl 0 0 0)
    
59.                          (list 0 scl 0 0)
    
60.                          (list 0 0 scl 0)
    
61.                          '(0 0 0 1)
    
62.                    )
    
63.               mat  (Mat:mxm (cadr mat2) (Mat:mxm mat0 (car mat1)))
    
64.         )
    
65.         (setq mat (Mat:mxm (cadr mat2) (car mat1)))
    
66.       )
    
67. 
    
68.       (setq app (vlax-get-acad-object))
    
69.       (setq doc (vla-get-ActiveDocument app))
    
70.       (vla-StartUndoMark doc)
    
71.       (setq i 0)
    
72.       (if sel
    
73.         (repeat        (sslength sel)
    
74.           (setq ent (ssname sel i))
    
75.           (setq obj (vlax-ename->vla-object ent))
    
76.           (vla-transformby obj (vlax-tmatrix mat))
    
77.           (setq i (1+ i))
    
78.         )
    
79.       )
    
80.       (vla-EndUndoMark doc)
    
81.       (vlax-release-object doc)
    
82.       (vlax-release-object app)
    
83.     )
    
84.   )
    
85.   (princ)
    
86. )
    

;;;先选目标三个点,再点目标三个点,似乎解决了鼠标移来移去的问题,但<br /> ;;;使用起来不方便.Autocad设计的align的点取顺序,还是很道理的.<br /> ;;;自贡黄明儒:H版的这个程序,可以演绎出许多我们自己需要的程序<br /> <br /> ;;;-----------------------------------------------------------;;<br /> ;;; 三点维的平齐命令，山寨Express Tools的align                ;;<br /> ;;; 命令:Align3d ，可自己修改                                 ;;<br /> ;;; Author: Highflybird, Date:2012-8-6.                       ;;<br /> ;;; All copyrights reserved.                                  ;;<br /> ;;;-----------------------------------------------------------;;<br /> (defun C:Align3d (/        sel   sP1   sP2          sP3        dP1   dP2   dP3          sclp<br />                   scl        mat0  mat1  mat2  mat        i     ent   obj          app<br />                   doc        pt<br />                  )<br />   (setvar "cmdecho" 0)<br />   (if (setq sel (ssget))<br />     (progn<br />       (initget 9)<br />       (setq sP1 (getpoint "\n 指定第一个源点:"))<br />       (initget 9)<br />       (princ "\n 指定第一个目标点:")<br />       (command "_.move" sel "" sP1 pause)<br />       (setq dP1 (getvar "lastpoint"))<br />       (setq pt (mapcar '- dP1 sP1))<br />       (initget 9)<br />       (setq sP2 (getpoint "\n 指定第二个源点:"))<br />       (initget 9)<br />       (setq dP2 (getpoint sP2 "\n 指定第二个目标点:"))<br />       (setq sP2 (mapcar '- sP2 pt))<br />       (initget 8)<br />       (setq sP3 (getpoint "\n 指定第三个源点或 <继续>:"))<br /> <br />       (if (null sP3)<br />         (progn<br />           (setq sP3 (Mat:Rotate90 sP2 sP1))<br />           (setq dP3 (Mat:Rotate90 dP2 dP1))<br />         )<br />         (progn<br />           (initget 9)<br />           (progn<br />             (setq dP3 (getpoint sP3 "\n 指定第三个目标点:"))<br />             (setq sP3 (mapcar '- sP3 pt))<br />           )<br />         )<br />       )<br />       (foreach x '(sP1 sP2 sP3 dP1 dP2 dP3)<br />         (set x (trans (eval x) 1 0))<br />       )<br />       (initget "Yes No")<br />       (setq sclp<br />              (getkword "\n 是否基于对齐点缩放对象？[是(Y)/否(N)] <否>:")<br />       )<br />       (command "_.move" sel "" dP1 sP1)<br />       (setq mat1 (Mat:Get3PMatrix sP1 sP2 sP3))<br />       (setq mat2 (Mat:Get3PMatrix dP1 dP2 dP3))<br />       (if (= "Yes" sclp)<br />         (setq scl  (/ (distance dP1 dP2) (distance sP2 sP1))<br />               mat0 (list (list scl 0 0 0)<br />                          (list 0 scl 0 0)<br />                          (list 0 0 scl 0)<br />                          '(0 0 0 1)<br />                    )<br />               mat  (Mat:mxm (cadr mat2) (Mat:mxm mat0 (car mat1)))<br />         )<br />         (setq mat (Mat:mxm (cadr mat2) (car mat1)))<br />       )<br /> <br />       (setq app (vlax-get-acad-object))<br />       (setq doc (vla-get-ActiveDocument app))<br />       (vla-StartUndoMark doc)<br />       (setq i 0)<br />       (if sel<br />         (repeat        (sslength sel)<br />           (setq ent (ssname sel i))<br />           (setq obj (vlax-ename->vla-object ent))<br />           (vla-transformby obj (vlax-tmatrix mat))<br />           (setq i (1+ i))<br />         )<br />       )<br />       (vla-EndUndoMark doc)<br />       (vlax-release-object doc)<br />       (vlax-release-object app)<br />     )<br />   )<br />   (princ)<br /> )<br />