分享一个我自己最常用的命令【拉伸或者移动至需要的距离】
本帖最后由 菜卷鱼 于 2024-2-23 10:43 编辑;;命令名： SQ
;;功能：选取一段距离，拉伸或者移动至需要的距离【只支持X或者Y方向】
;; by 菜卷鱼
;;使用方式：
;|先指定起点（参考点），再指定终点（目的点）或指定X方向或者Y方向，
如果没有指定方向，就会在指定终点之后自动选择终点相对于起点X轴与Y轴数字较大的方向，再选择要拉伸的对象（选择方式与S拉伸或者Move命令一样）|;
;;其余说明
;|这个程序写出来很多年了，虽然很简单，但是是我使用最频繁的命令，替代了大部分场景下的S（Stretch）命令
虽然也支持替代Move，但是用得少，因为Stretch可以替代Move
正常情况下，我们Stretch都是有个预期结果，比如初始距离100，我们想移动到500，就要先脑子里计算一下，然后输入400，整数还好，有些非整数可能需要敲计算器
这个命令，预期结果是把一段距离拉伸到500，选取初始距离之后，直接输入结果500就行，就是不管现在距离是多少，也不需要管中间计算|;
;;;照着左下角命令提示进行操作
(defun c:sq (/ *error* PT DT sv_pt_x
sv_pt_y sv_di_x sv_di_y sv_drictsv_ss
sep sv_npt eqkey sv_x_abssv_y_abs
sv_nvpt numrange
)
(defun numrange (num pre mode / n dw up s n1 n2)
(setq n (fix (/ num pre)))
(setq dw (* pre n 1.0))
(setq up (+ dw pre))
(cond
((= mode 1) (setq s up))
((= mode -1) (setq s dw))
(t
(setq n1(- up num)
n2(- num dw)
)
(if (>= n1 n2)
(setq s dw)
(setq s up)
)
)
)
s
)
(setq *error* cmderr)
(setq eqkey 0)
(if (= sv_cmd nil)
(setq sv_cmd "Stretch")
)
(mapcar 'princ
(list
"距离修正<选取一段距离Move或Stretch成需要的距离>"
"\n指定起点或设置[移动对象(M)/拉伸对象(S)]"
"<"
(substr sv_cmd 1 1)
">:"
)
)
(initget 1 "Move Stretch")
(setq pt (getpoint))
(while
(or (= pt "Move") (= pt "Stretch"))
(setq sv_cmd pt)
(mapcar 'princ
(list "\n指定起点或设置[移动对象(M)/拉伸对象(S)]:"
"<"
(substr sv_cmd 1 1)
">"
)
)
(initget 1 "Move Stretch")
(setq pt (getpoint))
)
(initget 1 "Xdirection Ydirection Auto")
(setq dt (getpoint pt "\n指定终点或<A>:"))
(while (/= (member dt (list "Xdirection" "Ydirection")) NIL)
(cond ((= dt "Xdirection") (setq eqkey 1))
((= dt "Ydirection") (setq eqkey 2))
((= dt "Auto") (setq eqkey 0))
)
(initget 1 "Xdirection Ydirection Auto")
(setq dt
(getpoint pt "\n指定终点或<A>:")
)
)
(setq sv_pt_x (car pt))
(setq sv_pt_y (cadr pt))
(setq sv_di_x (car dt))
(setq sv_di_y (cadr dt))
(setq sv_x_abs (abs (- sv_pt_x sv_di_x)))
(setq sv_y_abs (abs (- sv_pt_y sv_di_y)))
(cond
((= eqkey 1)
(setq sv_di sv_x_abs
sv_drict "X"
)
)
((= eqkey 2)
(setq sv_di sv_y_abs
sv_drict "Y"
)
)
((= eqkey 0)
(if (> sv_x_abs sv_y_abs)
(setq sv_di sv_x_abs
sv_drict "X"
)
(setq sv_di sv_y_abs
sv_drict "Y"
)
)
)
)
(mapcar 'princ
(list "\n选取<" sv_drict ">方向距离: " sv_di)
)
(if (numberp osv_num)
(mapcar
'princ
(list
"\n上一次"
osv_num
"\n修改至[对齐(空)/同上一次(S)/精度十(F)/百(H)千(T)]<对齐>:"
)
)
(princ "\n修改至[对齐(空)/精度十(F)/百(H)千(T)]<对齐>:")
)
(initget "Same Fix Hdd Ths")
(setq sv_num (getdist))
(if (and (numberp sv_num)
(/= sv_num 0)
)
(setq osv_num sv_num)
)
(cond
((= sv_num nil) (setq sv_num 0))
((= sv_num "Same") (setq sv_num osv_num))
((= sv_num "Fix") (setq sv_num (numrange sv_di 10 0)))
((= sv_num "Hdd") (setq sv_num (numrange sv_di 100 0)))
((= sv_num "Ths") (setq sv_num (numrange sv_di 1000 0))
)
)
(cond
((and (= sv_drict "X") (> (- sv_pt_x sv_di_x) 0))
(setq sv_num (- 0 sv_num))
)
((and (= sv_drict "X") (< (- sv_pt_x sv_di_x) 0))
(setq sv_num sv_num)
)
((and (= sv_drict "Y") (> (- sv_pt_y sv_di_y) 0))
(setq sv_num (- 0 sv_num))
)
((and (= sv_drict "Y") (< (- sv_pt_y sv_di_y) 0))
(setq sv_num sv_num)
)
)
(cond((= sv_drict "X")
(setq sv_nvpt (list (+ sv_di_x (- sv_num (- sv_di_x sv_pt_x)))
sv_di_y
0
)
)
)
((= sv_drict "Y")
(setq sv_nvpt (list sv_di_x
(+ sv_di_y (- sv_num (- sv_di_y sv_pt_y)))
0
)
)
)
)
(princ sv_num)
(princ "\n选取要移动的对象:")
(setq sv_ss (ssget))
(while (null sv_ss) (setq sv_ss (ssget)))
(setvar "cmdecho" 0)
(command "_.undo" "_be")
(setq *error* undoerr)
(command sv_cmd sv_ss "" "non" dt "non" sv_nvpt)
;;;;如果你的电脑不支持"non"，就用下面的方式，non的作用是取消捕捉
;;;;(setq osmode(getvar 'osmode))
;;;;(setvar 'osmode 0)
;;;;(command sv_cmd sv_ss ""dt sv_nvpt)
;;;;(setvar 'osmode osmode)
(command "_.undo" "_e")
(setvar "cmdecho" 1)
(prin1)
)
(command sv_cmd sv_ss "" "non" dt "non" sv_nvpt)
如果你的电脑不支持"non"，就用下面的方式，non的作用是取消捕捉
(setq osmode(getvar 'osmode))
(setvar 'osmode 0)
(command sv_cmd sv_ss ""dt sv_nvpt)
(setvar 'osmode osmode)
自用的小程序，分享一下，利用是对象捕捉中的捕捉自（from）
(defun c:sfr (/ *error* ss pt1 pt2)
(defun *error* (msg)
(setvar "autosnap" 63)
)
(prompt "\n★功能:将图形拉伸到指定的尺寸.\n")
(setvar "cmdecho" 0)
(setvar "orthomode" 1)
(if (and
(setq ss (ssget))
(setq pt1 (getpoint "\n指定基点:"))
(setq pt2 (getpoint pt1 "\n指定起点:"))
)
(command "_.stretch" ss "" "non" pt1 "from" "non"pt2 pause)
)
(setvar "autosnap" 63)
(princ)
) zxp2007 发表于 2024-1-22 17:07
这个功能 燕秀工具箱有类似的 并且做的很完善。不清楚是不是LISP开发的
燕秀的我没用过，不喜欢开机有广告
我的没那么完善，毕竟代码就那么一点，对我个人来说够用了 大佬，神速啊，这么快就出手了 谢谢楼主分享好用工具 你好，能否给个gif演示？ 感谢大神无私分享 这个功能 燕秀工具箱有类似的 并且做的很完善。不清楚是不是LISP开发的
感谢大佬分享 不咋好用啊 谢谢楼主分享。
谢谢楼主分享.