求助:点选直线靠角点的边得出对角点
点选直线靠角点的边得出对角点,谢谢如图
(DEFUN C:cd()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setq nm 0)
(setq test t)
(while test
(setq ss (entsel "\n请点选矩形:"))
(setq test (not ss))
)
(command "LAYER" "S" (cdr (assoc 8 (entget (car ss)))) "" )
(setq obj (vlax-ename->vla-object (car ss)))
(setq PT2 (vlax-curve-getclosestpointto obj (cadr ss)))
(setq pt3 (osnap pt2 "midp"))
(setq pta (osnap pt2 "end"))
(command "_RECTANG" pta )
(princ)
) (defun c:tt ()
(while (setq e1 (entsel "\n请点选矩形<退出>: "))
(setq s1 (car e1)
p1 (cadr e1)
)
(command "layer" "s" (cdr (assoc 8 (entget s1))) "")
(setq p2 (osnap (vlax-curve-getclosestpointto s1 p1) "end"))
(command "_rectang" p2 pause)
)
(princ)
) 本帖最后由 ZZXXQQ 于 2014-9-5 20:54 编辑
(defun c:tt ()
(setvar "CMDECHO" 0)
(while (and (setq s1 (entsel "\n选择矩形长边一点: "))
(setq ent (entget(car s1)))
(= (cdr(assoc 0 ent)) "LWPOLYLINE"))
(setq ptlst (list))
(foreach x ent (if (= (car x) 10) (setq ptlst (cons (cdr x) ptlst))))
(setq ptlst (reverse ptlst))
(setq p1 (osnap (cadr s1) "END"))
(setq p2 (osnap (cadr s1) "NEAR"))
(setq ang (angle p2 p1))
(while (not(equal (distance p1 (car ptlst)) 0 1e-6))
(setq ptlst (append (cdr ptlst) (list(car ptlst))))
)
(setq ang1 (angle (caddr ptlst) p1))
(if (or (> ang ang1) (and (equal ang 0 1e-6) (> ang1 pi)))
(setq p3 (polar (polar p1 (+ (/ pi 2) ang) 5) (+ pi ang) 12))
(setq p3 (polar (polar p1 (- ang (/ pi 2)) 5) (+ pi ang) 12))
)
(command "_.RECTANG" p1 p3)
)
(setvar "CMDECHO" 1)
(princ)
)
xyp1964 发表于 2014-9-4 22:05 static/image/common/back.gif
对xyp1964老大的这个程序太好啦，能否把程序发出来谢谢 小距形尺寸5*12 ZZXXQQ 发表于 2014-9-4 21:25 static/image/common/back.gif
这个程序右下角红色框会跑出外面
页:
[1]