马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
论坛以前ST写过一个,http://bbs.xdcad.net/thread-672368-1-1.html
这个修改自那个,修改的地方是拉角点的时候,拽动的是顶点,这样更符合需要。
[sell](defun c:XDTB_StretchRectang (/ an an1 d d1 dynpt e i inxs lst mat msg
my_err near norm1 norm2 p p1 p2 pam ptl pts
scl str v v1 v2 vx vy x
)
(defun my_err (msg)
(princ "\n")
(princ msg)
(xdrx_end)
(xd::doc:command (list ".undo" 1))
(setq *error* nil)
)
(defun callback (dynpt / d d1 scl)
(setq v (mapcar
'-
dynpt
p
)
)
(setq norm1 (xdrx_vector_perpvector vx)
norm2 (xdrx_vector_perpvector vy)
v1 (xdrx_vector_orthoproject v norm1)
v2 (xdrx_vector_orthoproject v norm2)
)
(xdrx_polyline_setpointat e near dynpt)
(xdrx_polyline_setpointat e (car inxs) (mapcar
'+
p1
v2
)
)
(xdrx_polyline_setpointat e (cadr inxs) (mapcar
'+
p2
v1
)
)
)
(defun callback1 (dynpt / d ptl)
(setq d (apply
'xdrx_point_dist2line
(cons dynpt pts)
)
ptl (mapcar
'(lambda (x)
(polar x an1 d)
)
pts
)
)
(mapcar
'(lambda (i x)
(xdrx_polyline_setpointat e i x)
)
lst
ptl
)
)
(if (and
(setq e (xdrx_entsel "\n点选多义线<退出>: " '((0 . "lwpolyline"))))
(xdrx_polyline_compress (car e))
(XD::Polyline:IsRectang (car e))
)
(progn
(xd::begin)
(setq *error* my_err)
(xdrx_sysvar_push '("osmode" 33))
(setq p (cadr e)
e (car e)
pam (xdrx_curve_getparamatpoint e (trans p 1 0))
pts (xdrx_polyline_getlinesegat e (fix pam))
)
(if (<= 0.34 (cadr (xdrx_math_modf pam)) 0.67)
(progn
(xdrx_sysvar_push '("orthomode" 1))
(setq lst (XD::Polyline:SegIndex e (fix pam))
an (apply
'angle
pts
)
an1 (- an _pi2)
str "Callback1"
p (trans p 1 0)
)
)
(progn
(xdrx_sysvar_push '("orthomode" 0))
(setq mat (xdrx_matrix_identity 3)
near (XD::Polyline:NearIndex e (trans p 1 0))
p (xdrx_polyline_getpointat e near)
inxs (xd::polyline:-index+ e near)
p1 (xdrx_polyline_getpointat e (car inxs))
p2 (xdrx_polyline_getpointat e (cadr inxs))
vx (xdrx_vector_normalize (mapcar
'-
p1
p
)
)
vy (xdrx_vector_normalize (mapcar
'-
p2
p
)
)
)
(setq str "callback")
)
)
(xdrx_pointmonitor str e)
(getpoint (trans p 0 1))
(xdrx_pointmonitor)
(xdrx_sysvar_pop)
(xd::end)
)
)
(princ)
)
[/sell] |