快速引线求助

alexmai

论坛引线程序有点复杂，想弄个简单的，自己捣鼓了整个晚上，还是弄不出来，向各位求助

(defun c:ws1(/ ent)
  (command "qLEADER" (setq pt1 (getpoint))  (setq pt2 (getpoint)) (setq pt (getpoint)) "")
  (princ)
)

start4444

(defun c:tt5 (/ ang entdate entname entype p10 p11 pt1 pt2 pt3)
(setq entname (car (entsel "\n选择射线:")) entdate (entget entname) p10 (cdr (assoc 10 entdate)) p11 (cdr (assoc 11 entdate)) p11 (list (+ (car p10) (car p11)) (+ (cadr p10) (cadr p11))) ang (angle p10 p11))       
(while (setq pt1 (getpoint "\n选择点位:"))
(setq pt2 (inters pt1 (polar pt1 (+ ang (* 0.5 pi)) 111) p10 p11 nil) pt3 (polar pt2 ang 5))       
(entmake (list '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader")  (cons 10 pt1) (cons 10 pt2)
   (cons 10 pt3)
    )
  )       
)       
(princ)       
)

alexmai

通过这个程序学会 polar，大感谢！

alexmai

start4444 发表于 2021-9-6 12:41
(defun c:tt5 (/ ang entdate entname entype p10 p11 pt1 pt2 pt3)
(setq entname (car (entsel "\n选择 ...

测试时发现这个问题
水平方向的 引线不需要出头，感谢

alexmai

start4444 发表于 2021-9-6 12:41
(defun c:tt5 (/ ang entdate entname entype p10 p11 pt1 pt2 pt3)
(setq entname (car (entsel "\n选择 ...

我加了个判断(if (= ang 0) 搞定了，大感谢！

pizi158545086

alexmai 发表于 2021-9-6 18:15
我加了个判断(if (= ang 0) 搞定了，大感谢！

你说的(if (= ang 0)是加在哪里的  可以发完整源码给我吗？谢谢

alexmai

pizi158545086 发表于 2021-12-10 10:47
你说的(if (= ang 0)是加在哪里的  可以发完整源码给我吗？谢谢

2. ;;;引线小程序
   
3. (defun c:tt (/ ang entdate entname entype p10 p11 pt1 pt2 pt3)
   
4. (setq entname (car (entsel "\n选择射线:")) entdate (entget entname) p10 (cdr (assoc 10 entdate)) p11 (cdr (assoc 11 entdate)) p11 (list (+ (car p10) (car p11)) (+ (cadr p10) (cadr p11))) ang (angle p10 p11))
   
5. (if (= ang 0)
   
6. (while (setq pt1 (getpoint "\n选择点位:"))
   
7. (setq pt2 (inters pt1 (polar pt1 (+ ang (* 0.5 pi)) 111) p10 p11 nil) pt3 (polar pt2 ang 3))      
   
8. (entmake (list '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader")  (cons 10 pt1) (cons 10 pt2)
   
9.    (cons 10 pt3)
   
10.        )
    
11.   )
    
12. );while
    
13. (while (setq pt1 (getpoint "\n选择点位:"))
    
14. (setq pt2 (inters pt1 (polar pt1 (+ ang (* 0.5 pi)) 111) p10 p11 nil))      
    
15. (entmake (list '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader")  (cons 10 pt1) (cons 10 pt2)
    
16.     )
    
17.   )   
    
18. );while
    
19. );if  

;;;引线小程序<br /> (defun c:tt (/ ang entdate entname entype p10 p11 pt1 pt2 pt3)<br /> (setq entname (car (entsel "\n选择射线:")) entdate (entget entname) p10 (cdr (assoc 10 entdate)) p11 (cdr (assoc 11 entdate)) p11 (list (+ (car p10) (car p11)) (+ (cadr p10) (cadr p11))) ang (angle p10 p11))<br /> (if (= ang 0)<br /> (while (setq pt1 (getpoint "\n选择点位:"))<br /> (setq pt2 (inters pt1 (polar pt1 (+ ang (* 0.5 pi)) 111) p10 p11 nil) pt3 (polar pt2 ang 3))       <br /> (entmake (list '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader")  (cons 10 pt1) (cons 10 pt2)<br />    (cons 10 pt3)<br />        )<br />   ) <br /> );while<br /> (while (setq pt1 (getpoint "\n选择点位:"))<br /> (setq pt2 (inters pt1 (polar pt1 (+ ang (* 0.5 pi)) 111) p10 p11 nil))       <br /> (entmake (list '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader")  (cons 10 pt1) (cons 10 pt2)<br />     )<br />   )   <br /> );while<br /> );if  

pizi158545086

alexmai 发表于 2021-12-11 10:58

非常感谢  好人一生平安