求助老师们帮写一个程序，直线两端延长再两端拐角

loveu515

求助老师们帮写一个程序，直线两端延长（两端延长的数值是一个变量，输入延长的长度，带记忆功能）再两端拐角（拐角长度也是变量，拐角是和直线垂直的，输入拐角长度，带记忆功能），然后再把这三条线段合并成多段线。谢谢啦。

start4444

(defun c:tt5 (/ ang ang1 d  ddd  en p1 p2 p3 p4 p5 p6 pt_per px)
(if (not DD)
        (setq DD 30)) (setq DD (if (setq D (getdist (strcat "\n输入延迟长<" (rtos DD 2 2) ">:"))) D DD))
(if (not DDdd)
        (setq DDdd 50)) (setq DDdd (if (setq Ddd (getdist (strcat "\n输入垂直长<" (rtos DDdd 2 2) ">:"))) Ddd Dddd))
(setq en (car (entsel "\n选择线:")) p3  (getpoint "\n垂直线方向:"))               
(if  (equal (cdr (assoc 0 (entget en))) "LWPOLYLINE")(setq p1 (car (Dptlst en)) p2 (cadr (Dptlst en))) (setq p1 (cdr (assoc 10 (entget en))) p2 (cdr (assoc 11 (entget en)))))        

(setq ang (angle p1 p2) p4 (polar p3 (+ ang (* 0.5 pi)) 1) pt_per (inters p1 p2 p3 p4 nil) ang1 (angle pt_per p3))            
(setq p3 (polar p1 (+ pi ang) dd) p4 (polar p2 ang dd) p5 (polar p3 ang1 dddd) p6 (polar p4 ang1 dddd))        
(command "pline" "non" p5  "non" p3 "non" p4 "non" p6 "")   
(entdel en)     
(princ)        
)
(defun Dptlst (enn / ent lst)
        (setq ent (entget enn))
        (setq lst (list))
        (foreach x ent (if (= (car x) 10) (setq lst (cons (cdr x) lst))))
        lst
)

loveu515

路过的大神帮帮忙，就是输入直线的延长值和垂线的长度，然后把这3个线段合并

SdlFreeCAD

加qq1005144760

loveu515

start4444 发表于 2023-5-26 13:13
(defun c:tt5 (/ ang d ddd en p1 p2 p3 p4 p5 p6)
(if (not DD)
        (setq DD 30)) (setq DD (if (setq D  ...

非常感谢帮忙！我用的时候发现，直线必须是水平的，画出来的垂线才对，延长值是带记忆上一次的，但垂直值不是上一次的，垂直值不输入的话一直都是50。可能是我没表述清楚，我想要的是：任何角度的直线，执行命令后两端延长再加两端垂线（垂线是与该直线垂直)，再删除掉原来的直线。

如果可以的话，可不可以做成既能选择直线，又能选择多段线呢？有时候也碰到直线是多段线的情况。给添麻烦啦。

loveu515

start4444 发表于 2023-5-26 13:13
(defun c:tt5 (/ ang ang1 d  ddd  en p1 p2 p3 p4 p5 p6 pt_per px)
(if (not DD)
        (setq DD 30)) (set ...

非常完美了！能把原来的直线在程序中删掉吗？

loveu515

start4444 发表于 2023-5-24 10:49
(defun c:tt5 (/ ang ang1 d  ddd  en p1 p2 p3 p4 p5 p6 pt_per px)
(if (not DD)
        (setq DD 30 ...

可以了 谢谢啦

loveu515

start4444 发表于 2023-5-24 10:49
(defun c:tt5 (/ ang ang1 d  ddd  en p1 p2 p3 p4 p5 p6 pt_per px)
(if (not DD)
        (setq DD 30 ...

能不能再帮下忙，改成连续选择呀？用的时候发现选完一条直线后，命令就结束了，再选其他直线，需要重新启用命令

loveu515

这样可以连续选择了

1. (defun c:tt5 (/ ang ang1 d  ddd  en p1 p2 p3 p4 p5 p6 pt_per px)
   
2.   (defun Dptlst (enn / ent lst)
   
3.         (setq ent (entget enn))
   
4.         (setq lst (list))
   
5.         (foreach x ent (IF (= (car x) 10) (setq lst (cons (cdr x) lst))))
   
6.         lst
   
7. )
   
8. (if (not DD)
   
9.         (setq DD 12)) (setq DD (if (setq D (getdist (strcat "\n输入延迟长<" (rtos DD 2 2) ">:"))) D DD))
   
10. (if (not DDdd)
    
11.         (setq DDdd 10)) (setq DDdd (if (setq Ddd (getdist (strcat "\n输入垂直长<" (rtos DDdd 2 2) ">:"))) Ddd Dddd))
    
12. (WHILE (setq en (car (entsel "\n选择线:")) p3  (getpoint "\n垂直线方向:"))               
    
13. (IF  (equal (cdr (assoc 0 (entget en))) "LWPOLYLINE")(setq p1 (car (Dptlst en)) p2 (cadr (Dptlst en))) (setq p1 (cdr (assoc 10 (entget en))) p2 (cdr (assoc 11 (entget en)))))        
    
14. 
    
15. (setq ang (angle p1 p2) p4 (polar p3 (+ ang (* 0.5 pi)) 1) pt_per (inters p1 p2 p3 p4 nil) ang1 (angle pt_per p3))            
    
16. (setq p3 (polar p1 (+ pi ang) dd) p4 (polar p2 ang dd) p5 (polar p3 ang1 dddd) p6 (polar p4 ang1 dddd))        
    
17. (command "pline" "non" p5  "non" p3 "non" p4 "non" p6 "")   
    
18. (entdel en)     
    
19. (princ)
    
20. )
    
21.   )
    

(defun c:tt5 (/ ang ang1 d  ddd  en p1 p2 p3 p4 p5 p6 pt_per px)<br />   (defun Dptlst (enn / ent lst)<br />         (setq ent (entget enn))<br />         (setq lst (list))<br />         (foreach x ent (IF (= (car x) 10) (setq lst (cons (cdr x) lst))))<br />         lst<br /> )<br /> (if (not DD)<br />         (setq DD 12)) (setq DD (if (setq D (getdist (strcat "\n输入延迟长<" (rtos DD 2 2) ">:"))) D DD))<br /> (if (not DDdd)<br />         (setq DDdd 10)) (setq DDdd (if (setq Ddd (getdist (strcat "\n输入垂直长<" (rtos DDdd 2 2) ">:"))) Ddd Dddd))<br /> (WHILE (setq en (car (entsel "\n选择线:")) p3  (getpoint "\n垂直线方向:"))               <br /> (IF  (equal (cdr (assoc 0 (entget en))) "LWPOLYLINE")(setq p1 (car (Dptlst en)) p2 (cadr (Dptlst en))) (setq p1 (cdr (assoc 10 (entget en))) p2 (cdr (assoc 11 (entget en)))))        <br /> <br /> (setq ang (angle p1 p2) p4 (polar p3 (+ ang (* 0.5 pi)) 1) pt_per (inters p1 p2 p3 p4 nil) ang1 (angle pt_per p3))            <br /> (setq p3 (polar p1 (+ pi ang) dd) p4 (polar p2 ang dd) p5 (polar p3 ang1 dddd) p6 (polar p4 ang1 dddd))        <br /> (command "pline" "non" p5  "non" p3 "non" p4 "non" p6 "")   <br /> (entdel en)     <br /> (princ) <br /> )<br />   )<br />