飞鸟的程序必须支持
支持高飞兄，学习了
顶这个代码，确实太好用了，感谢楼主。
做个演示吧
研究一下下
vlisp2012 发表于 2012-9-7 21:08 static/image/common/back.gif
还是犀牛的模式好，先指定3个源点，再指定3个目标点。省得鼠标两边跑
【低仿Align命令】
;;为了表示对H版此贴的支持,写如下程序
;;为了你的鼠标不移来移去,同时符合Autocad的习惯
;;H版的程序牵涉到久被人遗忘的<线性代数>,头疼.本程序用的是土办法
;;为了表示对H版此贴的支持,写如下程序
;;为了你的鼠标不移来移去,同时符合Autocad的习惯
;;H版的程序牵涉到久被人遗忘的<线性代数>,头疼.本程序用的是土办法
;;written by 自贡黄明儒
;;移动+旋转+缩放,相当于Align,本命令用于二维绘图
(defun HH:MSRotate (/ APP DOC P1 P2 P3 P4 REPLY SS)
(setq app (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument app))
(vla-StartUndoMark doc)
(and (setq ss (ssget))
(setq p1 (getpoint "\n 指定第一个源点:"))
(princ "\n 指定第一个目标点:")
(command "_.move" ss "" p1 pause)
)
(setq p3 (getvar "LASTPOINT"))
(and p1
(setq p2 (getpoint "\n 指定第二个源点:"))
(setq p4 (getpoint "\n 指定第二个目标点:"))
(command "_.ROTATE" ss "" p3 "R" p3 p2 p4)
)
(initget "Yes No")
(setq
reply
(GETKWORD "\n 是否基于对齐点缩放对象？[是(Y)/否(N)] <否>:")
)
(if (equal reply "Yes")
(progn (setq p2 (mapcar '- p2 (mapcar '- p3 p1)))
(setq p2 (/ (distance p3 p4) (distance p1 p2)))
(command "_.scale" ss "" p3 p2)
)
)
(vla-EndUndoMark doc)
(vlax-release-object doc)
(vlax-release-object app)
(princ)
)
好程序必须要支持支持
大儒，好样的，顶你！！！
学习~~
kwok 发表于 2012-9-7 23:02 static/image/common/back.gif
赞同，cad把简单事弄复杂化了,,,,,,,,
;;;先选目标三个点,再点目标三个点,似乎解决了鼠标移来移去的问题,但
;;;使用起来不方便.Autocad设计的align的点取顺序,还是很道理的.
;;;自贡黄明儒:H版的这个程序,可以演绎出许多我们自己需要的程序
;;;先选目标三个点,再点目标三个点,似乎解决了鼠标移来移去的问题,但
;;;使用起来不方便.Autocad设计的align的点取顺序,还是很道理的.
;;;自贡黄明儒:H版的这个程序,可以演绎出许多我们自己需要的程序
;;;-----------------------------------------------------------;;
;;; 三点维的平齐命令，山寨Express Tools的align ;;
;;; 命令:Align3d ，可自己修改 ;;
;;; Author: Highflybird, Date:2012-8-6. ;;
;;; All copyrights reserved. ;;
;;;-----------------------------------------------------------;;
(defun C:Align3d (/ sel sP1 sP2 sP3 dP1 dP2 dP3 sclp
scl mat0mat1mat2mat i ent obj app
doc pt
)
(setvar "cmdecho" 0)
(if (setq sel (ssget))
(progn
(initget 9)
(setq sP1 (getpoint "\n 指定第一个源点:"))
(initget 9)
(princ "\n 指定第一个目标点:")
(command "_.move" sel "" sP1 pause)
(setq dP1 (getvar "lastpoint"))
(setq pt (mapcar '- dP1 sP1))
(initget 9)
(setq sP2 (getpoint "\n 指定第二个源点:"))
(initget 9)
(setq dP2 (getpoint sP2 "\n 指定第二个目标点:"))
(setq sP2 (mapcar '- sP2 pt))
(initget 8)
(setq sP3 (getpoint "\n 指定第三个源点或 <继续>:"))
(if (null sP3)
(progn
(setq sP3 (Mat:Rotate90 sP2 sP1))
(setq dP3 (Mat:Rotate90 dP2 dP1))
)
(progn
(initget 9)
(progn
(setq dP3 (getpoint sP3 "\n 指定第三个目标点:"))
(setq sP3 (mapcar '- sP3 pt))
)
)
)
(foreach x '(sP1 sP2 sP3 dP1 dP2 dP3)
(set x (trans (eval x) 1 0))
)
(initget "Yes No")
(setq sclp
(getkword "\n 是否基于对齐点缩放对象？[是(Y)/否(N)] <否>:")
)
(command "_.move" sel "" dP1 sP1)
(setq mat1 (Mat:Get3PMatrix sP1 sP2 sP3))
(setq mat2 (Mat:Get3PMatrix dP1 dP2 dP3))
(if (= "Yes" sclp)
(setq scl(/ (distance dP1 dP2) (distance sP2 sP1))
mat0 (list (list scl 0 0 0)
(list 0 scl 0 0)
(list 0 0 scl 0)
'(0 0 0 1)
)
mat(Mat:mxm (cadr mat2) (Mat:mxm mat0 (car mat1)))
)
(setq mat (Mat:mxm (cadr mat2) (car mat1)))
)
(setq app (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument app))
(vla-StartUndoMark doc)
(setq i 0)
(if sel
(repeat (sslength sel)
(setq ent (ssname sel i))
(setq obj (vlax-ename->vla-object ent))
(vla-transformby obj (vlax-tmatrix mat))
(setq i (1+ i))
)
)
(vla-EndUndoMark doc)
(vlax-release-object doc)
(vlax-release-object app)
)
)
(princ)
)