求助:点选直线靠角点的边得出对角点

ymcui

点选直线靠角点的边得出对角点,谢谢
如图

xyp1964

ymcui

(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)
)

xyp1964

2. (defun c:tt ()
   
3.   (while (setq e1 (entsel "\n请点选矩形<退出>: "))
   
4.     (setq s1 (car e1)
   
5.           p1 (cadr e1)
   
6.     )
   
7.     (command "layer" "s" (cdr (assoc 8 (entget s1))) "")
   
8.     (setq p2 (osnap (vlax-curve-getclosestpointto s1 p1) "end"))
   
9.     (command "_rectang" p2 pause)
   
10.   )
    
11.   (princ)
    
12. )

(defun c:tt ()<br />   (while (setq e1 (entsel "\n请点选矩形<退出>: "))<br />     (setq s1 (car e1)<br />           p1 (cadr e1)<br />     )<br />     (command "layer" "s" (cdr (assoc 8 (entget s1))) "")<br />     (setq p2 (osnap (vlax-curve-getclosestpointto s1 p1) "end"))<br />     (command "_rectang" p2 pause)<br />   )<br />   (princ)<br /> )

ZZXXQQ

2. (defun c:tt ()
   
3. (setvar "CMDECHO" 0)
   
4. (while (and (setq s1 (entsel "\n选择矩形长边一点: "))
   
5.          (setq ent (entget(car s1)))
   
6.          (= (cdr(assoc 0 ent)) "LWPOLYLINE"))
   
7. (setq ptlst (list))
   
8. (foreach x ent (if (= (car x) 10) (setq ptlst (cons (cdr x) ptlst))))
   
9. (setq ptlst (reverse ptlst))
   
10. (setq p1 (osnap (cadr s1) "END"))
    
11. (setq p2 (osnap (cadr s1) "NEAR"))
    
12. (setq ang (angle p2 p1))
    
13. (while (not(equal (distance p1 (car ptlst)) 0 1e-6))
    
14.   (setq ptlst (append (cdr ptlst) (list(car ptlst))))
    
15. )
    
16. (setq ang1 (angle (caddr ptlst) p1))
    
17. (if (or (> ang ang1) (and (equal ang 0 1e-6) (> ang1 pi)))
    
18.   (setq p3 (polar (polar p1 (+ (/ pi 2) ang) 5) (+ pi ang) 12))
    
19.   (setq p3 (polar (polar p1 (- ang (/ pi 2)) 5) (+ pi ang) 12))
    
20. )
    
21. (command "_.RECTANG" p1 p3)
    
22. )
    
23. (setvar "CMDECHO" 1)
    
24. (princ)
    
25. )
    

(defun c:tt ()<br /> (setvar "CMDECHO" 0)<br /> (while (and (setq s1 (entsel "\n选择矩形长边一点: "))<br />          (setq ent (entget(car s1)))<br />          (= (cdr(assoc 0 ent)) "LWPOLYLINE"))<br /> (setq ptlst (list))<br /> (foreach x ent (if (= (car x) 10) (setq ptlst (cons (cdr x) ptlst))))<br /> (setq ptlst (reverse ptlst))<br /> (setq p1 (osnap (cadr s1) "END"))<br /> (setq p2 (osnap (cadr s1) "NEAR"))<br /> (setq ang (angle p2 p1))<br /> (while (not(equal (distance p1 (car ptlst)) 0 1e-6))<br />   (setq ptlst (append (cdr ptlst) (list(car ptlst))))<br /> )<br /> (setq ang1 (angle (caddr ptlst) p1))<br /> (if (or (> ang ang1) (and (equal ang 0 1e-6) (> ang1 pi)))<br />   (setq p3 (polar (polar p1 (+ (/ pi 2) ang) 5) (+ pi ang) 12))<br />   (setq p3 (polar (polar p1 (- ang (/ pi 2)) 5) (+ pi ang) 12))<br /> )<br /> (command "_.RECTANG" p1 p3)<br /> )<br /> (setvar "CMDECHO" 1)<br /> (princ)<br /> )<br />

xyp1964

ymcui

xyp1964 发表于 2014-9-4 22:05

对xyp1964老大的这个程序太好啦，能否把程序发出来谢谢

ymcui

小距形尺寸5*12

ymcui

ZZXXQQ 发表于 2014-9-4 21:25

这个程序右下角红色框会跑出外面