把LSP改为右键结束
在本论坛一位大侠哪得到以下LSP(先感谢)，作用是在很接近矩形的四边形的一个边上生成一个真正的矩形。求，把这个LPS改为批量选取四边形画矩形。如果批量有难度的话把这个LSP改为一直点下去，直到右键结束也行，感谢。(defun c:tt (/ BASEPT BBOX ENT MAXPT MINPT PT1 PT2 PTLST SEG TMPENT X)
(vl-load-com)
(while (and (setq ent (entsel "\n选择四边形:"))
(setq basept (osnap (cadr ent) "_nea"))
(setq ent (car ent)))
(setq ptlst (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent)))
(setq ptlst (mapcar '(lambda (x) (append (cdr x) (list 0.)))
(append ptlst (list (car ptlst)))))
(setq seg (fix (vlax-curve-getparamatpoint ent basept)))
(setq pt1 (nth seg ptlst))
(setq pt2 (nth (1+ seg) ptlst))
(setq tmpent (vlax-invoke-method (vlax-ename->vla-object ent) 'copy))
(vlax-invoke-method tmpent 'Rotate (vlax-3d-point pt1) (* -1 (angle pt1 pt2)))
(vlax-invoke-method tmpent 'GetBoundingBox 'minpt 'maxpt)
(setq minpt (vlax-safearray->list minpt)
maxpt (vlax-safearray->list maxpt))
(command "_rectang" "_non" minpt "_non" maxpt)
(setq bbox (entlast))
(vlax-invoke-method
(vlax-ename->vla-object bbox)
'Rotate
(vlax-3d-point pt1)
(angle pt1 pt2)
)
(vla-erase tmpent)
)
(princ)
)
十分感谢两位的帮助，就是我样要的。
页:
[1]