（XD::Drag:Move）通用拖动移动函数（支持 改基点、对齐、缩放、左右翻、上下翻、...
(defun XD::Drag:Move (info ss basepoint mode / _keys
an an1 box d1 d2 dynpt kw
lastang mat mat1 p1 p2 pt
ptbase s1 s2 scl ss2 yorn ret
)
(defun _keyword (kw)
(defun _rcallback (dynpt)
(if (not lastang)
(setq lastang (angle p1 dynpt))
)
(setq an (- (setq an1 (angle p1 dynpt)) lastang)
mat (xdrx-matrix-setrotation an '(0 0 1) p1)
)
(xdrx-entity-transform ss mat)
(xd::text:adjust ss)
(setq mat1 (xdrx-matrix-product mat mat1))
(setq lastang an1)
)
(defun _micallback (dynpt)
(xdrx-entity-delete ss2)
(setq ss2 (xdrx-entity-copy ss t))
(setq mat (xdrx-matrix-setmirror (list (trans p1 1 0) dynpt)))
(xdrx-entity-transform ss2 mat)
(xd::text:adjust ss2)
(setq mat1 (xdrx-matrix-product mat mat1))
)
(defun _sclcallback (dynpt)
(xdrx-entity-delete ss2)
(setq ss2 (xdrx-entity-copy ss t))
(setq box (xdrx-points-ucs2wcs (xdrx-entity-box ss2)))
(setq mat (xdrx-matrix-setscale
(/ (distance dynpt (trans p1 1 0))
(distance (car box) (nth 3 box))
)
(trans p1 1 0)
)
)
(xdrx-entity-transform ss2 mat)
(xd::text:adjust ss2)
(setq mat1 (xdrx-matrix-product mat mat1))
)
(setq ptbase (xd::drag:getbasepoint))
(cond
((= kw "T")
(if (setq pt (getpoint "\n新的基点<退出>:"))
(progn (xd::drag:setbasepoint (trans pt 1 0)))
)
)
((= kw "A")
(setq mat (xdrx-matrix-setrotation (/ pi 2.0) '(0 0 1) p1))
(xdrx-entity-transform ss mat)
)
((= kw "R")
(setq p1 (xd::drag:getbasepoint)
mat1 (xdrx-matrix-identity 3)
)
(xdrx-pointmonitor "_rcallback")
(if (not (setq p2 (getpoint p1 "\n旋转轴第二点<退出>:")))
(progn
(xdrx-entity-transform ss2 (xdrx-matrix-inverse mat1))
)
)
(xdrx-pointmonitor)
(xd::drag:setbasepoint (trans p1 1 0))
)
((= kw "M")
(setq mat1 (xdrx-matrix-identity 3))
(if (and (setq p1 (getpoint "\n镜像轴第一点<退出>:"))
(xdrx-pointmonitor "_micallback")
(setq p2 (getpoint p1 "\n镜像轴第二点<退出>:"))
)
(progn (setq mat (xdrx-matrix-setmirror
(list (trans p1 1 0) (trans p2 1 0))
)
)
(xdrx-entity-delete ss2)
(xdrx-entity-transform ss mat)
(xd::text:adjust ss)
)
(progn (xdrx-entity-transform ss (xdrx-matrix-inverse mat1))
)
)
(xdrx-pointmonitor)
)
((= kw "S")
(setq mat
(xdrx-matrix-setmirror
(list ptbase
(mapcar '+ ptbase (trans (getvar "ucsydir") 1 0 t))
)
)
)
(xdrx-entity-transform ss mat)
(xd::text:adjust ss)
)
((= kw "D")
(setq mat
(xdrx-matrix-setmirror
(list ptbase
(mapcar '+ ptbase (trans (getvar "ucsxdir") 1 0 t))
)
)
)
(xdrx-entity-transform ss mat)
(xd::text:adjust ss)
)
((= kw "L")
(setq mat1 (xdrx-matrix-identity 3))
(if (and (setq p1 (getpoint "\n基点<退出>:"))
(xdrx-pointmonitor "_sclcallback")
(setq p2 (getpoint p1 "\n镜第二点<输入>:"))
)
(progn (xdrx-entity-delete ss2)
(xdrx-entity-transform ss mat)
(xd::text:adjust ss)
)
(progn
(if (setq scl (getreal "\n输入放大比例系数<退出>:"))
(progn (setq mat (xdrx-matrix-setscale scl (trans p1 1 0)))
(xdrx-entity-transform ss mat)
)
)
)
)
(xdrx-pointmonitor)
)
((= kw "F")
(if (and (setq yorn (xdrx-yesorno "\n是否缩放:" 0))
(setq s1 (getpoint "\n对齐源轴第一点<退出>:"))
(setq s2 (getpoint s1 "\n源轴第二点<退出>:"))
(xdrx-grdraw 1 -1 s1 s2)
(setq d1 (getpoint "\n对齐目标轴第一点<退出>:"))
(setq d2 (getpoint d1 "\n对齐目标轴第二点<退出>:"))
)
(progn (xdrx-entity-align
ss
ptbase
(mapcar '+
ptbase
(mapcar '- (trans s2 1 0) (trans s1 1 0))
)
(trans d1 1 0)
(trans d2 1 0)
(if (= yorn 1)
t
nil
)
)
)
)
)
)
(setq ptbase (xd::drag:getbasepoint))
)
(if (not mode)
(setq mode 7)
)
(if (not basepoint)
(setq basepoint 5)
)
(if (= (type basepoint) 'INT)
(progn (setq basepoint (abs basepoint))
(if (or (< basepoint 1) (> basepoint 9))
(setq basepoint 5)
)
(setq basepoint (xd::geom:get9pt ss basepoint))
)
)
(setq lastang nil
_keys nil
)
(if (not info)
(setq info "\n插入点")
)
(setq info (strcat info "["))
(setq _keys (cons "T" _keys)
info(xdrx-prompt info "改基点(T)" t)
)
(if (= (rem 2 mode) 2)
(setq _keys (cons "F" _keys)
info (xdrx-prompt info "/对齐(F)" t)
)
)
(if (= (rem 4 mode) 4)
(setq _keys (cons "A" _keys)
info (xdrx-prompt info "/转90度(A)" t)
)
)
(if (= (rem 8 mode) 8)
(setq _keys (cons "S" _keys)
info (xdrx-prompt info "/左右翻(S)" t)
)
)
(if (= (rem 16 mode) 16)
(setq _keys (cons "D" _keys)
info (xdrx-prompt info "/上下翻(D)" t)
)
)
(if (= (rem 32 mode) 32)
(setq _keys (cons "R" _keys)
info (xdrx-prompt info "/改转角(R)" t)
)
)
(if (= (rem 64 mode) 64)
(setq _keys (cons "M" _keys)
info (xdrx-prompt info "/镜像(M)" t)
)
)
(if (= (rem 128 mode) 128)
(setq _keys (cons "L" _keys)
info (xdrx-prompt info "/缩放(L)" t)
)
)
(setq _keys (xdrx-string-join _keys " "))
(setq info (strcat info "]<退出>:"))
(and (xd::drag:setbasepoint (trans basepoint 1 0))
(xd::doc:setkeyword _keys)
(xd::drag:callbacksetkeyword "_keyword")
(setq ret (xd::drag:simplemove ss info (trans basepoint 1 0) t))
)
ret
)
非常好用的函数，功能齐全，值得拥有！ 很好的资料，感谢分享 学习学习 感谢感谢， 非常棒的通用拖动移动函数，很多地方都用得到，需要好好学习下。
页:
[1]