[LISP函数]：一个通过对话框绘制腰孔的程序

正航

绘制遥控程序，原创，稍作修改可以改为绘制其他图形(比如矩形)等。
LISP文件：

2. 
   
3. (defun c:edrawyk (/ tl th bl dcl_id next x y p1 p3 pa pb pc pd s1 oang)
   
4.   (setq bl (getvar "dimlfac"))  ;;读取比例
   
5.   (princ "\n当前绘图比例: 1: ")
   
6.   (princ bl)
   
7.   (princ " .")
   
8.   (edraw11a)
   
9. )
   
10. 
    
11. (defun edraw11a        (/)
    
12.   (setq bl (getvar "dimlfac"))
    
13.   (setq dcl_id (load_dialog "edraw11.dcl"))
    
14.   (if (not (new_dialog "EDRAW1101" DCL_ID))
    
15.     (exit)
    
16.   )
    
17.   (set_tile "BLM"
    
18.             (strcat "当前绘图比例:  1:" (rtos bl) " 。")
    
19.   )
    
20.   (if (/= h nil)
    
21.     (set_tile "H" (rtos h))
    
22.   )
    
23.   (if (/= l nil)
    
24.     (set_tile "L" (rtos l))
    
25.   )
    
26.   (setq        x (dimx_tile "CK")
    
27.         y (dimy_tile "CK")
    
28.   )
    
29.   (start_image "CK")
    
30.   (slide_image
    
31.     0
    
32.     0
    
33.     x
    
34.     y
    
35.     "EDRAW1101")
    
36.   )
    
37.   (end_image)
    
38.   (action_tile "L" "(setq  l (distof (get_tile "L")))")
    
39.   (action_tile "H" "(setq  h (distof (get_tile "H")))")
    
40.   (action_tile "accept" "(done_dialog 1)")
    
41.   (action_tile "cancel" "(done_dialog 0)")
    
42.   (setq next (start_dialog))
    
43.   (if (/= next 0)
    
44.     (edraw1101)
    
45.     (princ "\n用户取消程序！")
    
46.   )
    
47.   (unload_dialog dcl_id)
    
48.   (princ)
    
49. )
    
50. 
    
51. (defun edraw1101 ()
    
52.   (if (or (= l nil) (= l ""))
    
53.     (progn (alert "\n您未输入有效的L值!") (edraw11a))
    
54.   )
    
55.   (if (or (= h nil) (= h ""))
    
56.     (progn (alert "\n您未输入有效的H值!") (edraw11a))
    
57.   )
    
58.   (if (<= l h)
    
59.     (progn
    
60.       (alert "\n对不起，L值必须大于H值！")
    
61.       (edraw11a)
    
62.     )
    
63.     (edraw1103)
    
64.   )
    
65. )
    
66. 
    
67. (defun edraw1103 ()
    
68.   (setq tl (/ l bl))
    
69.   (setq th (/ h bl))
    
70.   (setq s1 1)
    
71.   (while s1
    
72.     (setq p1 (getpoint "\n腰孔的中心点：/<退出>"))
    
73.     (if        (= p1 nil)
    
74.       (setq s1 nil)
    
75.       (edraw1104)
    
76.     )
    
77.   )
    
78. )
    
79. 
    
80. (defun edraw1104 ()
    
81.   (if (= ang nil)
    
82.     (setq ang (/ pi 2))
    
83.   )
    
84.   (setq oang ang)
    
85.   (setq        ang
    
86.          (getangle
    
87.            p1
    
88.            (strcat "\n绘制方向<" (rtos (* (/ ang pi) 180)) " °>:")
    
89.          )
    
90.   )
    
91.   (if (= ang nil)
    
92.     (setq ang oang)
    
93.   )
    
94.   (setq p3 (polar p1 ang (/ th 2)))
    
95.   (setq pa (polar p3 (+ ang (/ pi 2)) (/ (- tl th) 2)))
    
96.   (setq pd (polar p3 (- ang (/ pi 2)) (/ (- tl th) 2)))
    
97.   (setq pb (polar pa (+ ang pi) th))
    
98.   (setq pc (polar pd (+ ang pi) th))
    
99.   (command ".pline"
    
100.            pa
     
101.            "Arc"
     
102.            "R"
     
103.            (/ th 2)
     
104.            pb
     
105.            "L"
     
106.            pc
     
107.            "Arc"
     
108.            "R"
     
109.            (/ th 2)
     
110.            pd
     
111.            "L"
     
112.            pa
     
113.            ""
     
114.   )
     
115. )
     
116. 
     
117. ;;
     
118. DCL 文件如下：
     
119. 
     
120. dcl_settings : default_dcl_settings { audit_level = 3; }
     
121. EDRAW1101 : dialog {
     
122.    initial_focus = "L" ;
     
123.    label = "工程绘图" ;
     
124.    : boxed_column {
     
125.       fixed_width = true ;
     
126.       fixed_height = true ;
     
127.       width = 28 ;
     
128.       height = 9 ;
     
129.       : image {
     
130.          color = black ;
     
131.          key = "CK" ;
     
132.          fixed_width = true ;
     
133.          fixed_height = true ;
     
134.          width = 28 ;
     
135.          height = 9 ;
     
136.       }
     
137.    }
     
138.    : boxed_column {
     
139.       fixed_width = true ;
     
140.       width = 29 ;
     
141.       height = 5 ;
     
142.       : edit_box {
     
143.          edit_width = 12 ;
     
144.          key = "L" ;
     
145.          label = "长度(mm)L=" ;
     
146.          width = 3 ;
     
147.          height = 1 ;
     
148.       }
     
149.       : edit_box {
     
150.          edit_width = 12 ;
     
151.          key = "H" ;
     
152.          label = "高度(mm)H=" ;
     
153.          width = 3 ;
     
154.          height = 1 ;
     
155.       }
     
156.    }
     
157.    : text {
     
158.       key = "BLM" ;
     
159.       value="当前比例";
     
160.       fixed_width = true ;
     
161.       width = 36 ;
     
162.       height = 1 ;
     
163.    }
     
164.   
     
165.     ok_cancel ;
     
166. }
     
167. 
     
168. ;;;结束，请把文件保存为：edraw11.dcl,放在LISP文件的同一目录下
     
169. .
     

<br /> (defun c:edrawyk (/ tl th bl dcl_id next x y p1 p3 pa pb pc pd s1 oang)<br />   (setq bl (getvar "dimlfac"))  ;;读取比例<br />   (princ "\n当前绘图比例: 1: ")<br />   (princ bl)<br />   (princ " .")<br />   (edraw11a)<br /> )<br /> <br /> (defun edraw11a        (/)<br />   (setq bl (getvar "dimlfac"))<br />   (setq dcl_id (load_dialog "edraw11.dcl"))<br />   (if (not (new_dialog "EDRAW1101" DCL_ID))<br />     (exit)<br />   )<br />   (set_tile "BLM"<br />             (strcat "当前绘图比例:  1:" (rtos bl) " 。")<br />   )<br />   (if (/= h nil)<br />     (set_tile "H" (rtos h))<br />   )<br />   (if (/= l nil)<br />     (set_tile "L" (rtos l))<br />   )<br />   (setq        x (dimx_tile "CK")<br />         y (dimy_tile "CK")<br />   )<br />   (start_image "CK")<br />   (slide_image<br />     0<br />     0<br />     x<br />     y<br />     "EDRAW1101")<br />   )<br />   (end_image)<br />   (action_tile "L" "(setq  l (distof (get_tile "L")))")<br />   (action_tile "H" "(setq  h (distof (get_tile "H")))")<br />   (action_tile "accept" "(done_dialog 1)")<br />   (action_tile "cancel" "(done_dialog 0)")<br />   (setq next (start_dialog))<br />   (if (/= next 0)<br />     (edraw1101)<br />     (princ "\n用户取消程序！")<br />   )<br />   (unload_dialog dcl_id)<br />   (princ)<br /> )<br /> <br /> (defun edraw1101 ()<br />   (if (or (= l nil) (= l ""))<br />     (progn (alert "\n您未输入有效的L值!") (edraw11a))<br />   )<br />   (if (or (= h nil) (= h ""))<br />     (progn (alert "\n您未输入有效的H值!") (edraw11a))<br />   )<br />   (if (<= l h)<br />     (progn<br />       (alert "\n对不起，L值必须大于H值！")<br />       (edraw11a)<br />     )<br />     (edraw1103)<br />   )<br /> )<br /> <br /> (defun edraw1103 ()<br />   (setq tl (/ l bl))<br />   (setq th (/ h bl))<br />   (setq s1 1)<br />   (while s1<br />     (setq p1 (getpoint "\n腰孔的中心点：/<退出>"))<br />     (if        (= p1 nil)<br />       (setq s1 nil)<br />       (edraw1104)<br />     )<br />   )<br /> )<br /> <br /> (defun edraw1104 ()<br />   (if (= ang nil)<br />     (setq ang (/ pi 2))<br />   )<br />   (setq oang ang)<br />   (setq        ang<br />          (getangle<br />            p1<br />            (strcat "\n绘制方向<" (rtos (* (/ ang pi) 180)) " °>:")<br />          )<br />   )<br />   (if (= ang nil)<br />     (setq ang oang)<br />   )<br />   (setq p3 (polar p1 ang (/ th 2)))<br />   (setq pa (polar p3 (+ ang (/ pi 2)) (/ (- tl th) 2)))<br />   (setq pd (polar p3 (- ang (/ pi 2)) (/ (- tl th) 2)))<br />   (setq pb (polar pa (+ ang pi) th))<br />   (setq pc (polar pd (+ ang pi) th))<br />   (command ".pline"<br />            pa<br />            "Arc"<br />            "R"<br />            (/ th 2)<br />            pb<br />            "L"<br />            pc<br />            "Arc"<br />            "R"<br />            (/ th 2)<br />            pd<br />            "L"<br />            pa<br />            ""<br />   )<br /> )<br /> <br /> ;;<br /> DCL 文件如下：<br /> <br /> dcl_settings : default_dcl_settings { audit_level = 3; }<br /> EDRAW1101 : dialog {<br />    initial_focus = "L" ;<br />    label = "工程绘图" ;<br />    : boxed_column {<br />       fixed_width = true ;<br />       fixed_height = true ;<br />       width = 28 ;<br />       height = 9 ;<br />       : image {<br />          color = black ;<br />          key = "CK" ;<br />          fixed_width = true ;<br />          fixed_height = true ;<br />          width = 28 ;<br />          height = 9 ;<br />       }<br />    }<br />    : boxed_column {<br />       fixed_width = true ;<br />       width = 29 ;<br />       height = 5 ;<br />       : edit_box {<br />          edit_width = 12 ;<br />          key = "L" ;<br />          label = "长度(mm)L=" ;<br />          width = 3 ;<br />          height = 1 ;<br />       }<br />       : edit_box {<br />          edit_width = 12 ;<br />          key = "H" ;<br />          label = "高度(mm)H=" ;<br />          width = 3 ;<br />          height = 1 ;<br />       }<br />    }<br />    : text {<br />       key = "BLM" ;<br />       value="当前比例";<br />       fixed_width = true ;<br />       width = 36 ;<br />       height = 1 ;<br />    }<br />   <br />     ok_cancel ;<br /> }<br /> <br /> ;;;结束，请把文件保存为：edraw11.dcl,放在LISP文件的同一目录下<br /> .<br />

附件中的文件是幻灯片图。请放在程序同一目录下即可。

lsjjm

是不是太繁琐了些?

正航

可能有点繁吧，不过使用中不会太麻烦吧。我的原意是想类似特定的图形，都可以用这样的方式来制作个程序，以后在使用中会方便些。这个程序本来是给在板式塔的塔板上打腰孔用的。