[原创]：画两直线的角平分线或对称线的程序

lijiao

如题
命令为：PFX

2. 
   
3.   [FONT=courier new]
   
4. (defun c:pfx  (/     ANG   ANG0         ANG1  ANG2  BIAOJI         DIS   DIS1
   
5.                DIS2  DIS3  DIS4         ENT1  ENT2  PT           PT0         PT1   PT2
   
6.                PT3   PT4   PT5         PT6)
   
7. ;;;  (myerr)
   
8. ;;;  (varset "cmdecho" 0)
   
9. ;;;  (varset "osmode" 0)
   
10.   (cond
    
11.     ((and (setq ent1 (car (entsel "\n选择一条直线：")))
    
12.           (= "LINE" (cdr (assoc 0 (entget ent1))))
    
13.           )
    
14.      (redraw ent1 3)
    
15.      (while
    
16.        (or (not (car (setq ent2 (entsel "\n选择第二条直线："))))
    
17.            (not (= "LINE" (cdr (assoc 0 (entget (car ent2))))))
    
18.            )
    
19.        )
    
20.      (setq pt6 (osnap (cadr ent2) "nea"))
    
21.      (redraw ent1 4)
    
22.      (setq ent1        (line_data ent1)
    
23.            ent2        (line_data (car ent2)))
    
24.      (if (car (cadr ent1))
    
25.        (setq ang1 (atan (car (cadr ent1))))
    
26.        (setq ang1 (dtor 90))
    
27.        )
    
28.      (if (car (cadr ent2))
    
29.        (setq ang2 (atan (car (cadr ent2))))
    
30.        (setq ang2 (dtor 90))
    
31.        )
    
32.      (setq ang (/ (+ ang1 ang2) 2.0))
    
33.      (if (equal ang1 ang2 1e-5)
    
34.        (progn
    
35.          (setq ang0 (+ ang (dtor 90)))
    
36.          (setq pt1 (polar pt6 ang0 10.0))
    
37.          (setq pt2 (inters (nth 2 (cadr ent1))
    
38.                            (nth 3 (cadr ent1))
    
39.                            pt6
    
40.                            pt1
    
41.                            nil))
    
42.          (setq pt
    
43.                 (polar pt6 (angle pt6 pt2) (* 0.5 (distance pt6 pt2))))
    
44.          (command "copy" (last (cadr ent2)) "" pt6 pt)
    
45.          )
    
46.        (progn
    
47.          (setq pt (inters (nth 2 (cadr ent1))
    
48.                           (nth 3 (cadr ent1))
    
49.                           (nth 2 (cadr ent2))
    
50.                           (nth 3 (cadr ent2))
    
51.                           nil))
    
52.          (setq biaoji t)
    
53.          (while        biaoji
    
54.            (setq pt0 (grread t 4 0))
    
55.            (cond
    
56.              ((= 5 (car pt0))
    
57.               (setq pt0         (cadr pt0)
    
58.                     dis         (distance pt pt0)
    
59.                     pt1         (polar pt ang dis)
    
60.                     pt2         (polar pt (+ ang (dtor 90)) dis)
    
61.                     pt3         (polar pt (+ ang (dtor 180)) dis)
    
62.                     pt4         (polar pt (+ ang (dtor 270)) dis)
    
63.                     dis1 (distance pt0 pt1)
    
64.                     dis2 (distance pt0 pt2)
    
65.                     dis3 (distance pt0 pt3)
    
66.                     dis4 (distance pt0 pt4)
    
67.                     dis         (min dis1 dis2 dis3 dis4)
    
68.                     pt5         (cadr (assoc dis
    
69.                                       (list (list dis1 pt1)
    
70.                                             (list dis2 pt2)
    
71.                                             (list dis3 pt3)
    
72.                                             (list dis4 pt4)
    
73.                                             )
    
74.                                       )
    
75.                                )
    
76.                     )
    
77.               (redraw)
    
78.               (grdraw pt pt5 1)
    
79.               )
    
80.              ((= 3 (car pt0))
    
81.               (setq biaoji nil)
    
82.               (redraw)
    
83.               (command "line" pt pt5 "")
    
84.               )
    
85.              (t t)
    
86.              )
    
87.            )
    
88.          )
    
89.        )
    
90.      )
    
91.     )
    
92. ;;;  (restore)
    
93.   (princ)
    
94.   )
    
95. (defun line_data  (ent / B K P1 P2 jd tc)
    
96.   (setq        p1 (vlax-curve-getstartpoint ent)
    
97.         p2 (vlax-curve-getendpoint ent)
    
98.         jd 1e-5
    
99.         tc (cdr (assoc 8 (entget ent)))
    
100.         )
     
101.   (if (equal (car p1) (car p2) jd)
     
102.     (setq k nil
     
103.           b (car p1)
     
104.           )
     
105.     (setq k (/ (- (cadr p2) (cadr p1))
     
106.                (- (car p2) (car p1))
     
107.                )
     
108.           b (- (cadr p1) (* (car p1) k))
     
109.           )
     
110.     )
     
111.   (setq        p2 (vl-sort (list p1 p2)
     
112.                     '(lambda (e1 e2)
     
113.                        (if (equal (car e1) (car e2) jd)
     
114.                          (< (cadr e1) (cadr e2))
     
115.                          (< (car e1) (car e2))
     
116.                          )
     
117.                        )
     
118.                     )
     
119.         p1 (car p2)
     
120.         p2 (cadr p2)
     
121.         )
     
122.   (cons        tc
     
123.         (list (list k
     
124.                     b
     
125.                     (list (car p1) (cadr p1))
     
126.                     (list (car p2) (cadr p2))
     
127.                     ent
     
128.                     )
     
129.               )
     
130.         )
     
131.   )
     
132. (defun dtor  (dat /)
     
133.   (* pi (/ dat 180.0))
     
134.   )
     
135.   [/FONT]
     

<br />   [FONT=courier new]<br /> (defun c:pfx  (/     ANG   ANG0         ANG1  ANG2  BIAOJI         DIS   DIS1<br />                DIS2  DIS3  DIS4         ENT1  ENT2  PT           PT0         PT1   PT2<br />                PT3   PT4   PT5         PT6)<br /> ;;;  (myerr)<br /> ;;;  (varset "cmdecho" 0)<br /> ;;;  (varset "osmode" 0)<br />   (cond<br />     ((and (setq ent1 (car (entsel "\n选择一条直线：")))<br />           (= "LINE" (cdr (assoc 0 (entget ent1))))<br />           )<br />      (redraw ent1 3)<br />      (while<br />        (or (not (car (setq ent2 (entsel "\n选择第二条直线："))))<br />            (not (= "LINE" (cdr (assoc 0 (entget (car ent2))))))<br />            )<br />        )<br />      (setq pt6 (osnap (cadr ent2) "nea"))<br />      (redraw ent1 4)<br />      (setq ent1        (line_data ent1)<br />            ent2        (line_data (car ent2)))<br />      (if (car (cadr ent1))<br />        (setq ang1 (atan (car (cadr ent1))))<br />        (setq ang1 (dtor 90))<br />        )<br />      (if (car (cadr ent2))<br />        (setq ang2 (atan (car (cadr ent2))))<br />        (setq ang2 (dtor 90))<br />        )<br />      (setq ang (/ (+ ang1 ang2) 2.0))<br />      (if (equal ang1 ang2 1e-5)<br />        (progn<br />          (setq ang0 (+ ang (dtor 90)))<br />          (setq pt1 (polar pt6 ang0 10.0))<br />          (setq pt2 (inters (nth 2 (cadr ent1))<br />                            (nth 3 (cadr ent1))<br />                            pt6<br />                            pt1<br />                            nil))<br />          (setq pt<br />                 (polar pt6 (angle pt6 pt2) (* 0.5 (distance pt6 pt2))))<br />          (command "copy" (last (cadr ent2)) "" pt6 pt)<br />          )<br />        (progn<br />          (setq pt (inters (nth 2 (cadr ent1))<br />                           (nth 3 (cadr ent1))<br />                           (nth 2 (cadr ent2))<br />                           (nth 3 (cadr ent2))<br />                           nil))<br />          (setq biaoji t)<br />          (while        biaoji<br />            (setq pt0 (grread t 4 0))<br />            (cond<br />              ((= 5 (car pt0))<br />               (setq pt0         (cadr pt0)<br />                     dis         (distance pt pt0)<br />                     pt1         (polar pt ang dis)<br />                     pt2         (polar pt (+ ang (dtor 90)) dis)<br />                     pt3         (polar pt (+ ang (dtor 180)) dis)<br />                     pt4         (polar pt (+ ang (dtor 270)) dis)<br />                     dis1 (distance pt0 pt1)<br />                     dis2 (distance pt0 pt2)<br />                     dis3 (distance pt0 pt3)<br />                     dis4 (distance pt0 pt4)<br />                     dis         (min dis1 dis2 dis3 dis4)<br />                     pt5         (cadr (assoc dis<br />                                       (list (list dis1 pt1)<br />                                             (list dis2 pt2)<br />                                             (list dis3 pt3)<br />                                             (list dis4 pt4)<br />                                             )<br />                                       )<br />                                )<br />                     )<br />               (redraw)<br />               (grdraw pt pt5 1)<br />               )<br />              ((= 3 (car pt0))<br />               (setq biaoji nil)<br />               (redraw)<br />               (command "line" pt pt5 "")<br />               )<br />              (t t)<br />              )<br />            )<br />          )<br />        )<br />      )<br />     )<br /> ;;;  (restore)<br />   (princ)<br />   )<br /> (defun line_data  (ent / B K P1 P2 jd tc)<br />   (setq        p1 (vlax-curve-getstartpoint ent)<br />         p2 (vlax-curve-getendpoint ent)<br />         jd 1e-5<br />         tc (cdr (assoc 8 (entget ent)))<br />         )<br />   (if (equal (car p1) (car p2) jd)<br />     (setq k nil<br />           b (car p1)<br />           )<br />     (setq k (/ (- (cadr p2) (cadr p1))<br />                (- (car p2) (car p1))<br />                )<br />           b (- (cadr p1) (* (car p1) k))<br />           )<br />     )<br />   (setq        p2 (vl-sort (list p1 p2)<br />                     '(lambda (e1 e2)<br />                        (if (equal (car e1) (car e2) jd)<br />                          (< (cadr e1) (cadr e2))<br />                          (< (car e1) (car e2))<br />                          )<br />                        )<br />                     )<br />         p1 (car p2)<br />         p2 (cadr p2)<br />         )<br />   (cons        tc<br />         (list (list k<br />                     b<br />                     (list (car p1) (cadr p1))<br />                     (list (car p2) (cadr p2))<br />                     ent<br />                     )<br />               )<br />         )<br />   )<br /> (defun dtor  (dat /)<br />   (* pi (/ dat 180.0))<br />   )<br />   [/FONT]<br />

lhj743

楼主，
很好用啊！
不但平分两线相交角度，
不相交也平分。
两条平行线可画出中线，中线长度和长的一样长！

lijiao

伙计，你太快了，刚发现一个毛病，就是(setq pt6 (osnap (cadr ent2) "nea"))，已经修改，你重新复制一下吧。
另外，就是错误处理程序和现场恢复部分，请各位自己编写吧。

lhj743

斑竹，我用起来很正常啊！
没什么问题。
那我还是重新复制啦！
很感谢你的大公无私！