浩辰CAD中的几个lisp，供参考

lucas_3333

无聊装了浩辰CAD2014版，试了下，不习惯，但是发现appload里加载的竟然有一些源码，这些论坛上已经有了（记忆中是这样）
发出来，有需要的可以参考下

1. ;;====此程序共有四部分内容
   
2. ;; 一.绘波浪线 ,命令是 PLX
   
3. ;; 二.绘轴截断 ,命令是 PLZ
   
4. ;; 三.绘1/4范围波浪线 命令是 PLX41
   
5. ;; 四.绘3/4范围波浪线 命令是 PLX43
   
6. ;;==========================================
   
7. ;;镜像点函数,mirr-x为X轴镜像,mirr-y为Y轴镜像
   
8. ;;px--被镜像点,po--镜像基点
   
9. (defun mirr-x (px po) (list (car px) (- (* 2 (cadr po)) (cadr px))))
   
10. (defun mirr-y (px po) (list (- (* 2 (car po)) (car px)) (cadr px)))
    
11. (defun dtr (x) (/ (* x pi) 180));;度至弧度的转换
    
12. (defun rtd (x) (/ (* x 180.0) pi))
    
13. (defun midpoint (p1 p2)         ;;两点的中点函数
    
14.    (list (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0)) )
    
15. ;;绘制波浪线函数初始化INIT_PLX;;;
    
16. (defun init_plx ( / q1)  
    
17.   (command "pline" (setq q1 (getvar "viewctr")) "w" 0 0 q1 ""
    
18.            "erase" "l" "")
    
19.   (setq jsq 0)
    
20.   (princ "******* 初始化成功 *******")
    
21. )
    
22. ;;绘制波浪线函数 PLX1
    
23. (defun plx1 (p1 p2 num /
    
24.              ang5 ang ang0 ang1 ang2 d12 d12mc ;;real
    
25.              p0                                ;;point
    
26.              num2 num3 n                       ;;int
    
27.             )
    
28.             ;;;pg (point)为后用;;;
    
29.    (if (< num 5) (setq ang5 15.0) (setq ang5 20.0))
    
30.    (setq ang (angle p1 p2)     ;;两点夹角
    
31.          ang0 (dtr ang5)       ;;波浪线角ang5=15 或 20度
    
32.          ang1 (+ ang ang0)     ;;++++
    
33.          ang2 (- ang ang0)     ;;----
    
34.          d12 (distance p1 p2)  ;;两点距离
    
35.          d12mc (/ d12 num 2.0 (cos ang0));;小段斜线距离
    
36.          num2 (* num 2)        ;;一个波浪线两小段
    
37.          num3 (1+ num2)        ;;总段数
    
38.          p0 p1
    
39.    )      
    
40.    (command "pline" p1)
    
41.    (setq n 1)
    
42.    (repeat num3         ;;;按段数绘制PLINE;;;
    
43.      (if (= n num3)      
    
44.       (command p2)      ;;;末点归位到第二点(末点)
    
45.       (if (= n 1)       ;;;第一点画法,取D12MC之半;;;
    
46.         (progn  
    
47.           (command (setq p0 (polar p0 ang1 (/ d12mc 2.0)) pg p0))
    
48.           ;;;(princ "***** ang=") (princ (rtd ang1))
    
49.         )
    
50.         (progn
    
51.          (if (= (rem n 2) 0);;按奇偶数的ang1 ang2产生波浪
    
52.           (command (setq p0 (polar p0 ang2 d12mc) pg p0))
    
53.           (command (setq p0 (polar p0 ang1 d12mc)))
    
54.          );if (= (rem n 2) 0)
    
55.         );progn
    
56.       );if n=1
    
57.      );if n=num3
    
58.      (setq n (1+ n))
    
59.    );repeat
    
60.    (command "")
    
61.    ;(command "pedit" p0 "f" "")  ;;曲线拟合
    
62.    ;(princ "请编辑所画的波浪线")
    
63.     ;(command "pedit" "l" "f" "")
    
64. );defun plx1
    
65. ;;==========================
    
66. ;;绘制波浪线命令 C:PLX
    
67. (defun c:plx ( / j
    
68.               jxm xzm                       ;;string
    
69.               q1 q2 pg                      ;;point
    
70.               nnn mmm oldos oldblip oldcmd  ;;int
    
71.              )
    
72.    ;;初始化pline命令的线宽为零,即W=0
    
73.    ;;为防止多次运行,设置计数器 JSQ=0 或 NIL;;
    
74.    (if (= jsq nil) (init_plx) )
    
75.    (setq mmm 1 q1 '() q2 '())
    
76.    (setq oldos (getvar "osmode"))
    
77.                  ;;存储原图的捕获模式 osmode
    
78. ;;   (if (/= oldos 512) (setvar "osmode" 512))
    
79.                  ;;设置 osmode 为 512, 即为捕获最近点
    
80.    (setq oldblip (getvar "blipmode"))
    
81.                  ;;存储原图的点标记符系统变量"+'
    
82.    (setq oldcmd (getvar "cmdecho"))
    
83.                  ;;存储原图的响应回显信息 cmdecho
    
84.    (if (= oldblip 1) (setvar "blipmode" 0))
    
85.        ;;点标记符系统变量 = 0 时 无 "+"
    
86.    (if (= oldcmd  1) (setvar "cmdecho" 0))
    
87.                  ;;回显信息 cmdecho为0,不回显
    
88.    (setq jxm "Y")
    
89.    (while (= jxm "Y")
    
90.     (cond
    
91.       ((= mmm 1) (print) (princ "第一条线..."))
    
92.       ((= mmm 2) (print) (princ "第二条线..."))
    
93.       ((>= mmm 3)(print) (princ "下一条线..."))
    
94.     )
    
95.     (princ " 请选择捕捉方式...")
    
96.     (graphscr)
    
97.     (setq q1 (getpoint "\n波浪线起点 : "))
    
98.     (if (= q1 '()) (setq q1 (getvar "viewctr")))
    
99.     (while (= q2 '())  
    
100.       (setq q2 (getpoint q1 "\n波浪线终点 : ")) )
     
101.     (setq nnn 8)
     
102.     (while (or (< nnn 2) (> nnn 7))
     
103.       (setq nnn (getint "\n波浪线的波段数 (2--7) < 3 > "))
     
104.       (if (= nnn nil) (setq nnn 3))
     
105.     );
     
106.     (PLX1 q1 q2 nnn)
     
107.     (setq q1 '() q2 '())
     
108.     (setq mmm (1+ mmm))
     
109.     (setq jxm (getstring "\n还要画吗 ? (Y/N) < N > "))
     
110. ;    (setq jxm "N")
     
111.     (setq jxm (strcase jxm))
     
112.   );while
     
113.   ;;;各系统变量复位;;;;
     
114. ;;  (setvar "osmode" oldos)
     
115.   (setvar "cmdecho" oldcmd)
     
116.   (setvar "blipmode" oldblip)
     
117. ;|   (setq xzm (getstring "\n波浪线程序需要卸载吗 ?(Y/N) < Y > "))
     
118.     (if (= zjm "") (setq xzm "Y"))
     
119.     (setq xzm (strcase xzm))
     
120.     (if (= xzm "Y")
     
121.         (setq c:plz nil @xy nil mirr-x nil mirr-y nil
     
122.               dtr nil rtd nil midpoint nil init_plx nil
     
123.               jsq nil plx1 nil c:plx nil)
     
124.     )|;if end
     
125. 
     
126. );defun plx
     
127. 
     
128. ;;==========================
     
129. ;;绘制1/4.象限 3/4象限波浪线
     
130. ;;==========================
     
131. (defun h_plx (p1 p2 p0 ang num a_base /
     
132.               d_a d01 d02 dcp x1 d_d d_r a r ;;real
     
133.               pbf n                          ;;int
     
134.               q00                            ;;point
     
135.              )
     
136.    (setq d_a (/ ang 1.0 num)
     
137.          d01 (distance p0 p1)
     
138.          d02 (distance p0 p2)
     
139.          dcp (/ (+ d01 d02) 2.0)
     
140.          x1  (- (car p1) (car p0))
     
141.          d_d (abs (/ (- d01 d02) num))
     
142.    )
     
143.    ;; 此组数据不很可靠,请再试DCP-->NN;;
     
144.    (cond
     
145.      ((and (> dcp 0)  (<= dcp 9))   (setq nn 30))
     
146.      ((and (> dcp 9)  (<= dcp 20))  (setq nn 40))
     
147.      ((and (> dcp 20) (<= dcp 50))  (setq nn 50))
     
148.      ((and (> dcp 50) (<= dcp 80))  (setq nn 60))
     
149.      ((and (> dcp 80) (<= dcp 120)) (setq nn 70))
     
150.      ((and (> dcp 120)(<= dcp 300)) (setq nn 80))
     
151.      (T                             (setq nn 90))
     
152.    )  
     
153.    (setq d_r (/ dcp nn))
     
154.    (if (>= d01 d02) (setq pbf -1) (setq pbf 1))
     
155.    (command "pline" p1)
     
156.    (setq n 1)
     
157.    (while (<= (* n d_a) ang)     ;;;按段数绘制PLINE;;;
     
158.      (if (>= (* n d_a) ang)
     
159.       (command p2)      ;;;末点归位到第二点(末点)
     
160.       (if (= n 1)       ;;;第一点画法,取D12MC之半;;;
     
161.         (progn   
     
162.            (setq r (+ d01 (* n d_d pbf) d_r)
     
163.                  a (+ a_base (/ d_a 2.0)) )
     
164.            (command (polar p0 (dtr a) r))
     
165.         )
     
166.         (progn
     
167.          (if (= (rem n 2) 0);;按奇偶数的ang1 ang2产生波浪
     
168.           (progn
     
169.             (setq r (+ (+ d01 (* (- n 1) d_d pbf)) d_r)
     
170.                   a (+ a_base (* (- n 1) d_a) (/ d_a 2.0)) )
     
171.             (command (setq q00 (polar p0 (dtr a) r)))
     
172.           )  
     
173.           (progn
     
174.             (setq r (- (+ d01 (* (1- n) d_d pbf)) d_r)
     
175.                   a (+ a_base (* (1- n) d_a) (/ d_a 2.0)) )
     
176.             (command (setq q00 (polar p0 (dtr a) r)))
     
177.           )
     
178.          );if (= (rem n 2) 0)
     
179.         );progn
     
180.       );if n=1
     
181.      );if n=num3
     
182.      (setq n (1+ n))
     
183.    );while
     
184.    (command "")
     
185.    (command "pedit" "l" "f" "")  ;;曲线拟合
     
186. );defun plx1
     
187. ;;绘制1/4.象限 3/4象限波浪线
     
188. (defun c:plx41 ( / r
     
189.        oldos oldblip oldcmd lx     ;;int
     
190.        q1 q2 q0                    ;;point
     
191.        x1 x2 y1 y2 r               ;;real
     
192.        angle number angbase
     
193.        d_xx                        ;;string
     
194.                )
     
195.     (if (= jsq nil) (init_plx) )
     
196.     (setq oldos (getvar "osmode"))
     
197.                   ;;存储原图的扑捉模式 osmode
     
198.     (if (/= oldos 512) (setvar "osmode" 512))
     
199.                  ;;设置 osmode 为 512, 即为捕获最近点
     
200.     (setq oldblip (getvar "blipmode"))
     
201.                  ;;存储原图的点标记符系统变量"+'
     
202.     (if (= oldblip 1) (setvar "blipmode" 0))
     
203.                  ;;点标记符系统变量 = 0 时 无 "+"
     
204.     (setq oldcmd (getvar "cmdecho"))
     
205.                  ;;存储原图的响应回显信息 cmdecho
     
206.     (if (= oldcmd  1) (setvar "cmdecho" 0))
     
207.                  ;;回显信息 cmdecho为0,不回显
     
208.     (princ " 如果想用捕获方式,请选择方式,现在默认最近点...")
     
209.     (setq q1 '() q2 '())
     
210.     (while (= q1 '())  
     
211.       (setq q1 (getpoint  "\n在轴的母线选另一点 : ")) )
     
212.     (while (= q2 '())  
     
213.       (setq q2 (getpoint q1 "\n在轴的端面线选另一点 : "))
     
214.       (setq x1 (car q1) y1 (cadr q1)
     
215.             x2 (car q2) y2 (cadr q2))
     
216.       (if (or (= x1 x2) (= y1 y2)) (setq q2 '()))
     
217.     )
     
218.     ;;变量D_XX为第几相限(1 2 3 4)的选定
     
219.     (cond
     
220.       ((> x1 x2)
     
221.          (if (> y1 y2)
     
222.              (setq q0 (list x2 y1) d_xx "4" angbase 270)
     
223.              (setq q0 (list x2 y1) d_xx "1" angbase   0)
     
224.          )
     
225.       )
     
226.       ((< x1 x2)
     
227.          (if (> y1 y2)
     
228.              (setq q0 (list x2 y1) d_xx "3" angbase 180)
     
229.              (setq q0 (list x2 y1) d_xx "2" angbase  90)
     
230.          )
     
231.       )
     
232.       ((or (= x1 x2) (= y1 y2))(prompt "不可能的情况 ! "))
     
233.     );cond
     
234.     (setq angle 90.0  number 15)
     
235.     (cond
     
236.       ((= d_xx "1") (H_PLX q1 q2 q0 angle number 0))
     
237.       ((= d_xx "2") (H_PLX q2 q1 q0 angle number 90))
     
238.       ((= d_xx "3") (H_PLX q1 q2 q0 angle number 180))
     
239.       ((= d_xx "4") (H_PLX q2 q1 q0 angle number 270))
     
240.     );cond
     
241. );;此段程序未完
     
242. (defun c:plx43 ( / r
     
243.        oldos oldblip oldcmd lx     ;;int
     
244.        q1 q2 q0                    ;;point
     
245.        x1 x2 y1 y2 r               ;;real
     
246.        angle number angbase
     
247.        d_xx                        ;;string
     
248.                )
     
249.     (if (= jsq nil) (init_plx) )
     
250.     (setq oldos (getvar "osmode"))
     
251.                   ;;存储原图的扑捉模式 osmode
     
252.     (if (/= oldos 512) (setvar "osmode" 512))
     
253.                  ;;设置 osmode 为 512, 即为捕获最近点
     
254.     (setq oldblip (getvar "blipmode"))
     
255.                  ;;存储原图的点标记符系统变量"+'
     
256.     (if (= oldblip 1) (setvar "blipmode" 0))
     
257.                  ;;点标记符系统变量 = 0 时 无 "+"
     
258.     (setq oldcmd (getvar "cmdecho"))
     
259.                  ;;存储原图的响应回显信息 cmdecho
     
260.     (if (= oldcmd  1) (setvar "cmdecho" 0))
     
261.                  ;;回显信息 cmdecho为0,不回显
     
262.     (princ " 如果想用捕获方式,请选择方式,现在默认最近点...")
     
263.     (setq q1 '() q2 '())
     
264.     (while (= q1 '())  
     
265.       (setq q1 (getpoint  "\n在轴的母线选另一点 : ")) )
     
266.     (while (= q2 '())  
     
267.       (setq q2 (getpoint q1 "\n在轴的端面线选另一点 : "))
     
268.       (setq x1 (car q1) y1 (cadr q1)
     
269.             x2 (car q2) y2 (cadr q2))
     
270.       (if (or (= x1 x2) (= y1 y2)) (setq q2 '()))
     
271.     )
     
272.     (cond
     
273.       ((> x1 x2)
     
274.          (if (> y1 y2)
     
275.              (setq q0 (list x2 y1) d_xx "4" angbase 270)
     
276.              (setq q0 (list x2 y1) d_xx "1" angbase   0)
     
277.          )
     
278.       )
     
279.       ((< x1 x2)
     
280.          (if (> y1 y2)
     
281.              (setq q0 (list x2 y1) d_xx "3" angbase 180)
     
282.              (setq q0 (list x2 y1) d_xx "2" angbase  90)
     
283.          )
     
284.       )
     
285.       ((or (= x1 x2) (= y1 y2))(prompt "不可能的情况 ! "))
     
286.     );cond
     
287.     (setq angle 270.0  number 27)
     
288.     (cond
     
289.       ((= d_xx "1") (H_PLX q2 q1 q0 angle number 90))
     
290.       ((= d_xx "2") (H_PLX q1 q2 q0 angle number 180))
     
291.       ((= d_xx "3") (H_PLX q2 q1 q0 angle number 270))
     
292.       ((= d_xx "4") (H_PLX q1 q2 q0 angle number 0))
     
293.     );cond
     
294. );;此段程序已完
     

;;====此程序共有四部分内容<br /> ;; 一.绘波浪线 ,命令是 PLX<br /> ;; 二.绘轴截断 ,命令是 PLZ<br /> ;; 三.绘1/4范围波浪线 命令是 PLX41<br /> ;; 四.绘3/4范围波浪线 命令是 PLX43<br /> ;;==========================================<br /> ;;镜像点函数,mirr-x为X轴镜像,mirr-y为Y轴镜像<br /> ;;px--被镜像点,po--镜像基点<br /> (defun mirr-x (px po) (list (car px) (- (* 2 (cadr po)) (cadr px))))<br /> (defun mirr-y (px po) (list (- (* 2 (car po)) (car px)) (cadr px)))<br /> (defun dtr (x) (/ (* x pi) 180));;度至弧度的转换<br /> (defun rtd (x) (/ (* x 180.0) pi))<br /> (defun midpoint (p1 p2)         ;;两点的中点函数<br />    (list (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0)) )<br /> ;;绘制波浪线函数初始化INIT_PLX;;;<br /> (defun init_plx ( / q1)  <br />   (command "pline" (setq q1 (getvar "viewctr")) "w" 0 0 q1 ""<br />            "erase" "l" "")<br />   (setq jsq 0)<br />   (princ "******* 初始化成功 *******")<br /> )<br /> ;;绘制波浪线函数 PLX1<br /> (defun plx1 (p1 p2 num / <br />              ang5 ang ang0 ang1 ang2 d12 d12mc ;;real<br />              p0                                ;;point<br />              num2 num3 n                       ;;int<br />             )<br />             ;;;pg (point)为后用;;;<br />    (if (< num 5) (setq ang5 15.0) (setq ang5 20.0))<br />    (setq ang (angle p1 p2)     ;;两点夹角<br />          ang0 (dtr ang5)       ;;波浪线角ang5=15 或 20度<br />          ang1 (+ ang ang0)     ;;++++<br />          ang2 (- ang ang0)     ;;----<br />          d12 (distance p1 p2)  ;;两点距离<br />          d12mc (/ d12 num 2.0 (cos ang0));;小段斜线距离<br />          num2 (* num 2)        ;;一个波浪线两小段<br />          num3 (1+ num2)        ;;总段数<br />          p0 p1 <br />    )      <br />    (command "pline" p1)<br />    (setq n 1)<br />    (repeat num3         ;;;按段数绘制PLINE;;;<br />      (if (= n num3)      <br />       (command p2)      ;;;末点归位到第二点(末点)<br />       (if (= n 1)       ;;;第一点画法,取D12MC之半;;;<br />         (progn  <br />           (command (setq p0 (polar p0 ang1 (/ d12mc 2.0)) pg p0))<br />           ;;;(princ "***** ang=") (princ (rtd ang1))<br />         )<br />         (progn<br />          (if (= (rem n 2) 0);;按奇偶数的ang1 ang2产生波浪<br />           (command (setq p0 (polar p0 ang2 d12mc) pg p0))<br />           (command (setq p0 (polar p0 ang1 d12mc)))<br />          );if (= (rem n 2) 0)<br />         );progn<br />       );if n=1<br />      );if n=num3<br />      (setq n (1+ n))<br />    );repeat<br />    (command "")<br />    ;(command "pedit" p0 "f" "")  ;;曲线拟合<br />    ;(princ "请编辑所画的波浪线")<br />     ;(command "pedit" "l" "f" "")<br /> );defun plx1<br /> ;;==========================<br /> ;;绘制波浪线命令 C:PLX<br /> (defun c:plx ( / j<br />               jxm xzm                       ;;string<br />               q1 q2 pg                      ;;point<br />               nnn mmm oldos oldblip oldcmd  ;;int<br />              )<br />    ;;初始化pline命令的线宽为零,即W=0<br />    ;;为防止多次运行,设置计数器 JSQ=0 或 NIL;;<br />    (if (= jsq nil) (init_plx) )<br />    (setq mmm 1 q1 '() q2 '())<br />    (setq oldos (getvar "osmode")) <br />                  ;;存储原图的捕获模式 osmode<br /> ;;   (if (/= oldos 512) (setvar "osmode" 512))<br />                  ;;设置 osmode 为 512, 即为捕获最近点<br />    (setq oldblip (getvar "blipmode"))<br />                  ;;存储原图的点标记符系统变量"+'<br />    (setq oldcmd (getvar "cmdecho"))<br />                  ;;存储原图的响应回显信息 cmdecho<br />    (if (= oldblip 1) (setvar "blipmode" 0))<br />        ;;点标记符系统变量 = 0 时 无 "+"<br />    (if (= oldcmd  1) (setvar "cmdecho" 0))<br />                  ;;回显信息 cmdecho为0,不回显<br />    (setq jxm "Y")<br />    (while (= jxm "Y")<br />     (cond<br />       ((= mmm 1) (print) (princ "第一条线..."))<br />       ((= mmm 2) (print) (princ "第二条线..."))<br />       ((>= mmm 3)(print) (princ "下一条线..."))<br />     )<br />     (princ " 请选择捕捉方式...")<br />     (graphscr)<br />     (setq q1 (getpoint "\n波浪线起点 : "))<br />     (if (= q1 '()) (setq q1 (getvar "viewctr")))<br />     (while (= q2 '())  <br />       (setq q2 (getpoint q1 "\n波浪线终点 : ")) )<br />     (setq nnn 8)<br />     (while (or (< nnn 2) (> nnn 7))<br />       (setq nnn (getint "\n波浪线的波段数 (2--7) < 3 > "))<br />       (if (= nnn nil) (setq nnn 3))<br />     );<br />     (PLX1 q1 q2 nnn)<br />     (setq q1 '() q2 '())<br />     (setq mmm (1+ mmm))<br />     (setq jxm (getstring "\n还要画吗 ? (Y/N) < N > "))<br /> ;    (setq jxm "N")<br />     (setq jxm (strcase jxm))<br />   );while<br />   ;;;各系统变量复位;;;;<br /> ;;  (setvar "osmode" oldos)<br />   (setvar "cmdecho" oldcmd)<br />   (setvar "blipmode" oldblip)<br /> ;|   (setq xzm (getstring "\n波浪线程序需要卸载吗 ?(Y/N) < Y > "))<br />     (if (= zjm "") (setq xzm "Y"))<br />     (setq xzm (strcase xzm))<br />     (if (= xzm "Y")<br />         (setq c:plz nil @xy nil mirr-x nil mirr-y nil <br />               dtr nil rtd nil midpoint nil init_plx nil<br />               jsq nil plx1 nil c:plx nil)<br />     )|;if end<br /> <br /> );defun plx<br /> <br /> ;;==========================<br /> ;;绘制1/4.象限 3/4象限波浪线<br /> ;;==========================<br /> (defun h_plx (p1 p2 p0 ang num a_base /<br />               d_a d01 d02 dcp x1 d_d d_r a r ;;real<br />               pbf n                          ;;int<br />               q00                            ;;point<br />              )<br />    (setq d_a (/ ang 1.0 num)<br />          d01 (distance p0 p1)<br />          d02 (distance p0 p2)<br />          dcp (/ (+ d01 d02) 2.0)<br />          x1  (- (car p1) (car p0))<br />          d_d (abs (/ (- d01 d02) num))<br />    )<br />    ;; 此组数据不很可靠,请再试DCP-->NN;;<br />    (cond<br />      ((and (> dcp 0)  (<= dcp 9))   (setq nn 30))<br />      ((and (> dcp 9)  (<= dcp 20))  (setq nn 40))<br />      ((and (> dcp 20) (<= dcp 50))  (setq nn 50))<br />      ((and (> dcp 50) (<= dcp 80))  (setq nn 60))<br />      ((and (> dcp 80) (<= dcp 120)) (setq nn 70))<br />      ((and (> dcp 120)(<= dcp 300)) (setq nn 80))<br />      (T                             (setq nn 90)) <br />    )  <br />    (setq d_r (/ dcp nn))<br />    (if (>= d01 d02) (setq pbf -1) (setq pbf 1))<br />    (command "pline" p1)<br />    (setq n 1)<br />    (while (<= (* n d_a) ang)     ;;;按段数绘制PLINE;;;<br />      (if (>= (* n d_a) ang)<br />       (command p2)      ;;;末点归位到第二点(末点)<br />       (if (= n 1)       ;;;第一点画法,取D12MC之半;;;<br />         (progn   <br />            (setq r (+ d01 (* n d_d pbf) d_r)<br />                  a (+ a_base (/ d_a 2.0)) )<br />            (command (polar p0 (dtr a) r))<br />         )<br />         (progn<br />          (if (= (rem n 2) 0);;按奇偶数的ang1 ang2产生波浪<br />           (progn<br />             (setq r (+ (+ d01 (* (- n 1) d_d pbf)) d_r)<br />                   a (+ a_base (* (- n 1) d_a) (/ d_a 2.0)) )<br />             (command (setq q00 (polar p0 (dtr a) r)))<br />           )  <br />           (progn<br />             (setq r (- (+ d01 (* (1- n) d_d pbf)) d_r)<br />                   a (+ a_base (* (1- n) d_a) (/ d_a 2.0)) )<br />             (command (setq q00 (polar p0 (dtr a) r)))<br />           )<br />          );if (= (rem n 2) 0)<br />         );progn<br />       );if n=1<br />      );if n=num3<br />      (setq n (1+ n))<br />    );while<br />    (command "")<br />    (command "pedit" "l" "f" "")  ;;曲线拟合<br /> );defun plx1<br /> ;;绘制1/4.象限 3/4象限波浪线<br /> (defun c:plx41 ( / r<br />        oldos oldblip oldcmd lx     ;;int<br />        q1 q2 q0                    ;;point<br />        x1 x2 y1 y2 r               ;;real <br />        angle number angbase<br />        d_xx                        ;;string<br />                )<br />     (if (= jsq nil) (init_plx) )<br />     (setq oldos (getvar "osmode")) <br />                   ;;存储原图的扑捉模式 osmode<br />     (if (/= oldos 512) (setvar "osmode" 512))<br />                  ;;设置 osmode 为 512, 即为捕获最近点<br />     (setq oldblip (getvar "blipmode"))<br />                  ;;存储原图的点标记符系统变量"+'<br />     (if (= oldblip 1) (setvar "blipmode" 0))<br />                  ;;点标记符系统变量 = 0 时 无 "+"<br />     (setq oldcmd (getvar "cmdecho"))<br />                  ;;存储原图的响应回显信息 cmdecho<br />     (if (= oldcmd  1) (setvar "cmdecho" 0))<br />                  ;;回显信息 cmdecho为0,不回显<br />     (princ " 如果想用捕获方式,请选择方式,现在默认最近点...")<br />     (setq q1 '() q2 '())<br />     (while (= q1 '())  <br />       (setq q1 (getpoint  "\n在轴的母线选另一点 : ")) )<br />     (while (= q2 '())  <br />       (setq q2 (getpoint q1 "\n在轴的端面线选另一点 : "))<br />       (setq x1 (car q1) y1 (cadr q1) <br />             x2 (car q2) y2 (cadr q2))<br />       (if (or (= x1 x2) (= y1 y2)) (setq q2 '()))<br />     )<br />     ;;变量D_XX为第几相限(1 2 3 4)的选定<br />     (cond<br />       ((> x1 x2)<br />          (if (> y1 y2)<br />              (setq q0 (list x2 y1) d_xx "4" angbase 270)<br />              (setq q0 (list x2 y1) d_xx "1" angbase   0)<br />          )<br />       )<br />       ((< x1 x2) <br />          (if (> y1 y2)<br />              (setq q0 (list x2 y1) d_xx "3" angbase 180)<br />              (setq q0 (list x2 y1) d_xx "2" angbase  90)<br />          )<br />       )<br />       ((or (= x1 x2) (= y1 y2))(prompt "不可能的情况 ! "))<br />     );cond<br />     (setq angle 90.0  number 15)<br />     (cond<br />       ((= d_xx "1") (H_PLX q1 q2 q0 angle number 0))<br />       ((= d_xx "2") (H_PLX q2 q1 q0 angle number 90))<br />       ((= d_xx "3") (H_PLX q1 q2 q0 angle number 180))<br />       ((= d_xx "4") (H_PLX q2 q1 q0 angle number 270))<br />     );cond<br /> );;此段程序未完<br /> (defun c:plx43 ( / r<br />        oldos oldblip oldcmd lx     ;;int<br />        q1 q2 q0                    ;;point<br />        x1 x2 y1 y2 r               ;;real <br />        angle number angbase<br />        d_xx                        ;;string<br />                )<br />     (if (= jsq nil) (init_plx) )<br />     (setq oldos (getvar "osmode")) <br />                   ;;存储原图的扑捉模式 osmode<br />     (if (/= oldos 512) (setvar "osmode" 512))<br />                  ;;设置 osmode 为 512, 即为捕获最近点<br />     (setq oldblip (getvar "blipmode"))<br />                  ;;存储原图的点标记符系统变量"+'<br />     (if (= oldblip 1) (setvar "blipmode" 0))<br />                  ;;点标记符系统变量 = 0 时 无 "+"<br />     (setq oldcmd (getvar "cmdecho"))<br />                  ;;存储原图的响应回显信息 cmdecho<br />     (if (= oldcmd  1) (setvar "cmdecho" 0))<br />                  ;;回显信息 cmdecho为0,不回显<br />     (princ " 如果想用捕获方式,请选择方式,现在默认最近点...")<br />     (setq q1 '() q2 '())<br />     (while (= q1 '())  <br />       (setq q1 (getpoint  "\n在轴的母线选另一点 : ")) )<br />     (while (= q2 '())  <br />       (setq q2 (getpoint q1 "\n在轴的端面线选另一点 : "))<br />       (setq x1 (car q1) y1 (cadr q1) <br />             x2 (car q2) y2 (cadr q2))<br />       (if (or (= x1 x2) (= y1 y2)) (setq q2 '()))<br />     )<br />     (cond<br />       ((> x1 x2)<br />          (if (> y1 y2)<br />              (setq q0 (list x2 y1) d_xx "4" angbase 270)<br />              (setq q0 (list x2 y1) d_xx "1" angbase   0)<br />          )<br />       )<br />       ((< x1 x2) <br />          (if (> y1 y2)<br />              (setq q0 (list x2 y1) d_xx "3" angbase 180)<br />              (setq q0 (list x2 y1) d_xx "2" angbase  90)<br />          )<br />       )<br />       ((or (= x1 x2) (= y1 y2))(prompt "不可能的情况 ! "))<br />     );cond<br />     (setq angle 270.0  number 27)<br />     (cond <br />       ((= d_xx "1") (H_PLX q2 q1 q0 angle number 90))<br />       ((= d_xx "2") (H_PLX q1 q2 q0 angle number 180))<br />       ((= d_xx "3") (H_PLX q2 q1 q0 angle number 270))<br />       ((= d_xx "4") (H_PLX q1 q2 q0 angle number 0))<br />     );cond<br /> );;此段程序已完<br />

yubihai

样条曲线多段线正好用得上,谢谢

sunny_8848

谢谢楼主分享，挺好用的

happy336

谢谢分享，学习了

ymcui

样条曲线多段线正好用得上,谢谢

yoyoho

感謝 lucas_3333 分享程序!

小师傅

顶楼主，感谢分享

434939575

感谢！下载了。

spp_wall

支持！！！！！！！！！！！！

tangjunasd58

alexmai

样条曲线多段线正好用得上,谢谢~~

陈亚娣

谢谢，下载了。

yshf

谢谢分享，下来学习学习！