[LISP函数]：一个绘制角平分线的程序

正航

用来画两条直线的角平分线的，原创

2. 
   
3. (defun c:dpfx (/ a1 a2 b1 b2 c1        c2 p1 p2 p3 p4 ang1 ang        ang2 leng ptt2
   
4.                pt2 pt1 pn ab s)
   
5.   (setvar "cmdecho" 0)
   
6.   (princ "\n    *******  绘角平分线程序  *******   ")
   
7.   (setq s 1)
   
8.   (while s
   
9.     (princ "\n请选择第一条直线:")
   
10.     (setq ab (entsel))
    
11.     (if        (= ab nil)
    
12.       (princ "请选择有效的直线实体！ ")
    
13.       (setq s nil)
    
14.     )
    
15.   )
    
16.   (setq a1 (entget (car ab)))
    
17.   (setq b1 (assoc 0 a1))
    
18.   (setq c1 (cdr b1))
    
19.   (if (= c1 "LINE")
    
20.     (progn
    
21.       (setq p1 (cdr (assoc 10 a1)))
    
22.       (setq p2 (cdr (assoc 11 a1)))
    
23.       (setq ang1 (angle p1 p2))
    
24.     )
    
25.     (progn
    
26.       (alert "\n您所选的实体并非直线!请重选!")
    
27.       (setq a1 (entget (car (entsel))))
    
28.       (terpri)
    
29.       (setq b1 (assoc 0 a1))
    
30.       (setq c1 (cdr b1))
    
31.       (setq p1 (cdr (assoc 10 a1)))
    
32.       (setq p2 (cdr (assoc 11 a1)))
    
33.       (setq ang1 (angle p1 p2))
    
34.     )
    
35.   )
    
36.   (setq s 1)
    
37.   (while s
    
38.     (princ "\n请选择第二条直线:")
    
39.     (setq a2 (entget (car (entsel))))
    
40.     (if        (/= a2 nil)
    
41.       (setq s nil)
    
42.     )
    
43.   )
    
44.   (setq b2 (assoc 0 a2))
    
45.   (setq c2 (cdr b2))
    
46.   (if (= c2 "LINE")
    
47.     (progn
    
48.       (setq p3 (cdr (assoc 10 a2)))
    
49.       (setq p4 (cdr (assoc 11 a2)))
    
50.       (setq ang2 (angle p3 p4))
    
51.     )
    
52.     (progn
    
53.       (alert "\n您所选的实体并非直线!请重选!")
    
54.       (setq a2 (entget (car (entsel))))
    
55.       (terpri)
    
56.       (setq b2 (assoc 0 a2))
    
57.       (setq c2 (cdr b2))
    
58.       (setq p3 (cdr (assoc 10 a2)))
    
59.       (setq p4 (cdr (assoc 11 a2)))
    
60.       (setq ang2 (angle p3 p4))
    
61.     )
    
62.   )
    
63.   (setq ang (/ (+ ang1 ang2) 2))
    
64.   (setvar "osmode" 32)
    
65.   (setq pn (getpoint "\n请选择两直线交点/<Enter无交点>:"))
    
66.   (setvar "osmode" 0)
    
67.   (setvar "snapang" ang)
    
68.   (setvar "orthomode" 1)
    
69.   (if (= pn nil)
    
70.     (progn
    
71.       (setq pt1 (getpoint "\n角平分线线起点:"))
    
72.       (setq pt2 (getpoint pt1 "\n角平分线终点/<Enter指定长度>:"))
    
73.       (if (= pt2 nil)
    
74.         (progn
    
75.           (setq len (getreal "\n角平分线长度:"))
    
76.           (setq len (/ len bl))
    
77.           (setq ptt2 (getpoint pt1 "\n直线方向:"))
    
78.           (setq ang1 (angle pt1 ptt2))
    
79.           (setq pt2 (polar pt1 ang1 len))
    
80.           (command ".line" pt1 pt2 "")
    
81.         )
    
82.         (command ".line" pt1 pt2 "")
    
83.       )
    
84.     )
    
85.     (progn
    
86.       (setq pt1 (getpoint pn "\n角平分线终点/<Enter指定长度>:"))
    
87.       (if (= pt1 nil)
    
88.         (progn
    
89.           (setq len (getreal "\n角平分线长度:"))
    
90.           (setq len (/ len bl))
    
91.           (setq ptt2 (getpoint pn "\n直线方向:"))
    
92.           (setq ang1 (angle pn ptt2))
    
93.           (setq pt2 (polar pn ang1 len))
    
94.           (command ".line" pn pt2 "")
    
95.         )
    
96.         (command ".line" pn pt1 "")
    
97.       )
    
98.     )
    
99.   )
    
100.   (setvar "snapang" 0)
     
101.   (princ "\n 角平分线绘制完毕!")
     
102.   (princ)
     
103. )
     

<br /> (defun c:dpfx (/ a1 a2 b1 b2 c1        c2 p1 p2 p3 p4 ang1 ang        ang2 leng ptt2<br />                pt2 pt1 pn ab s)<br />   (setvar "cmdecho" 0)<br />   (princ "\n    *******  绘角平分线程序  *******   ")<br />   (setq s 1)<br />   (while s<br />     (princ "\n请选择第一条直线:")<br />     (setq ab (entsel))<br />     (if        (= ab nil)<br />       (princ "请选择有效的直线实体！ ")<br />       (setq s nil)<br />     )<br />   )<br />   (setq a1 (entget (car ab)))<br />   (setq b1 (assoc 0 a1))<br />   (setq c1 (cdr b1))<br />   (if (= c1 "LINE")<br />     (progn<br />       (setq p1 (cdr (assoc 10 a1)))<br />       (setq p2 (cdr (assoc 11 a1)))<br />       (setq ang1 (angle p1 p2))<br />     )<br />     (progn<br />       (alert "\n您所选的实体并非直线!请重选!")<br />       (setq a1 (entget (car (entsel))))<br />       (terpri)<br />       (setq b1 (assoc 0 a1))<br />       (setq c1 (cdr b1))<br />       (setq p1 (cdr (assoc 10 a1)))<br />       (setq p2 (cdr (assoc 11 a1)))<br />       (setq ang1 (angle p1 p2))<br />     )<br />   )<br />   (setq s 1)<br />   (while s<br />     (princ "\n请选择第二条直线:")<br />     (setq a2 (entget (car (entsel))))<br />     (if        (/= a2 nil)<br />       (setq s nil)<br />     )<br />   )<br />   (setq b2 (assoc 0 a2))<br />   (setq c2 (cdr b2))<br />   (if (= c2 "LINE")<br />     (progn<br />       (setq p3 (cdr (assoc 10 a2)))<br />       (setq p4 (cdr (assoc 11 a2)))<br />       (setq ang2 (angle p3 p4))<br />     )<br />     (progn<br />       (alert "\n您所选的实体并非直线!请重选!")<br />       (setq a2 (entget (car (entsel))))<br />       (terpri)<br />       (setq b2 (assoc 0 a2))<br />       (setq c2 (cdr b2))<br />       (setq p3 (cdr (assoc 10 a2)))<br />       (setq p4 (cdr (assoc 11 a2)))<br />       (setq ang2 (angle p3 p4))<br />     )<br />   )<br />   (setq ang (/ (+ ang1 ang2) 2))<br />   (setvar "osmode" 32)<br />   (setq pn (getpoint "\n请选择两直线交点/<Enter无交点>:"))<br />   (setvar "osmode" 0)<br />   (setvar "snapang" ang)<br />   (setvar "orthomode" 1)<br />   (if (= pn nil)<br />     (progn<br />       (setq pt1 (getpoint "\n角平分线线起点:"))<br />       (setq pt2 (getpoint pt1 "\n角平分线终点/<Enter指定长度>:"))<br />       (if (= pt2 nil)<br />         (progn<br />           (setq len (getreal "\n角平分线长度:"))<br />           (setq len (/ len bl))<br />           (setq ptt2 (getpoint pt1 "\n直线方向:"))<br />           (setq ang1 (angle pt1 ptt2))<br />           (setq pt2 (polar pt1 ang1 len))<br />           (command ".line" pt1 pt2 "")<br />         )<br />         (command ".line" pt1 pt2 "")<br />       )<br />     )<br />     (progn<br />       (setq pt1 (getpoint pn "\n角平分线终点/<Enter指定长度>:"))<br />       (if (= pt1 nil)<br />         (progn<br />           (setq len (getreal "\n角平分线长度:"))<br />           (setq len (/ len bl))<br />           (setq ptt2 (getpoint pn "\n直线方向:"))<br />           (setq ang1 (angle pn ptt2))<br />           (setq pt2 (polar pn ang1 len))<br />           (command ".line" pn pt2 "")<br />         )<br />         (command ".line" pn pt1 "")<br />       )<br />     )<br />   )<br />   (setvar "snapang" 0)<br />   (princ "\n 角平分线绘制完毕!")<br />   (princ)<br /> )<br />

junkay

大家有什么好方法不妨拿出来讨论一下，资源共享嘛！

li809

这里有一个可以分享,网上收集来的

白莲森

正需要这东东！！

cy956

1。既然点了三下，还是“角点、一点、二点”更通用。
2。加一个选择，可以任意几等分。
3。选择的过滤判断比较繁琐，用内部函数更简捷。