[原创][LISP]以距离限差、角度限差和步进长度控制的SPLINE2PLINE

lockmyeye

1. ;;;==================================================================
2. ;;;转换SPLINE至PLINE
3. (DEFUN c:test (/ angle_dlta dist_dlta dist_step num1 ss1)
4. ;;;       (SETQ dist_step 1                                                         ;步进距离
5. ;;;                   dist_dlta 10                                                       ;允许偏离距离
6. ;;;                   angle_dlta 0.1                                                   ;允许偏离角度,360
7. ;;;       )
8.        (SETQ dist_step   (GETREAL "步进距离:")               ;步进距离
9.                    dist_dlta   (GETREAL "距离限差:")               ;允许偏离距离
10.                    angle_dlta (GETREAL "角度限差:")               ;允许偏离角度,360
11.        )
12.        (PRINC "\n\t选择SPLINE:")
13.        (spline2pline (SSGET '((0 . "SPLINE"))) dist_step dist_dlta angle_dlta)
14.        (PRINC)
15. )
16. ;;;转换SPLINE为LWPOLYLINE的折线
17. ;;;ENAME  实体名
18. ;;;思路：以SPLINE线上所有连续的两个拟合点为一个单位，进行插入处理。
19. ;;;  先以第一个拟合点作为基点，当基点前进若干个步进单位内的点的范围夹角大于偏离角度，
20. ;;;  或者范围夹角开口处的距离大于允许偏离距离，则插入一点,
21. ;;;  把插入点作为基点再继续，直到基点超过第二个拟合点为止。
22. ;;;  新生成LWPOLYLINE线中将保留原来的拟合点。
23. ;;;2/1/04 9:00 下午修改：非三阶拟合线没有拟合点时，只有起点和终点作为拟合点
24. ;;;2/1/04 9:00 下午修改：线方向与原SPLINE方向反了
25. ;;;ss1  实体或者选择集
26. ;;;DIST_STEP  步进距离
27. ;;;DIST_DLTA  允许偏离距离
28. ;;;ANGLE_DLTA  允许偏离角度,360
29. (DEFUN spline2pline (ss1                   dist_step
30.                                          dist_dlta       angle_dlta
31.                                          /                       angle_max
32.                                          angle_min       angle_now
33.                                          angle_tmp       curve-obj
34.                                          data                 dist_end
35.                                          dist_start     ename
36.                                          num1                 points_new
37.                                          points_old     point_base
38.                                          point_now
39.                                        )
40.        (IF (NOT ss1)
41.                (SETQ ss1 (SSADD))
42.        )
43.        (IF (OR (/= 'pickset (TYPE ss1))
44.                        (AND (/= 'real (TYPE dist_step)) (/= 'int (TYPE dist_step)))
45.                        (AND (/= 'real (TYPE dist_dlta)) (/= 'int (TYPE dist_dlta)))
46.                        (AND (/= 'real (TYPE angle_dlta)) (/= 'int (TYPE angle_dlta)))
47.                )
48.                (*error* "参数类型错。")
49.        )
50.        (IF (> (SSLENGTH ss1) 0)
51.                (PRINC (STRCAT "\n\t0\tSPLINE转换为LWPOLYLINE，共< " (ITOA (SSLENGTH ss1)) " >。"))
52.        )
53.        (SETQ angle_dlta (ABS (* (/ (REM angle_dlta 360.0) 180.0) PI))
54.                    num1             0
55.        )
56.        (REPEAT (SSLENGTH ss1)
57.                (SETQ ename           (SSNAME ss1 num1)
58.                            num1             (1+ num1)
59.                            data             (ENTGET ename)
60.                            points_old (IF (ASSOC '11 data)
61.                                                          (MAPCAR 'CDR (VL-REMOVE-IF '(LAMBDA (x) (/= 11 (CAR x))) data))
62.                                                          (LIST (CDR (ASSOC '10 data)) (CDR (ASSOC '10 (REVERSE data))))
63.                                                  )
64.                            points_new (LIST (CAR points_old))
65.                            points_old (CDR points_old)
66.                            curve-obj   (VLAX-ENAME->VLA-OBJECT ename)
67.                )
68.                (PRINC (STRCAT "\r\t" (ITOA num1)))
69.                ;;对拟合点进行循环
70.                (WHILE points_old
71.                        (SETQ dist_start (VLAX-CURVE-GETPARAMATPOINT curve-obj (CAR points_new))
72.                                    dist_end     (VLAX-CURVE-GETPARAMATPOINT curve-obj (CAR points_old))
73.                        )
74.                        ;;步进没到结束下一个拟合点
75.                        (WHILE (< (SETQ dist_start (+ dist_start dist_step)) dist_end)
76.                                (SETQ point_base (CAR points_new) ;指定方向的第一点
77.                                            angle_max   (ANGLE point_base (VLAX-CURVE-GETPOINTATPARAM curve-obj dist_start))
78.                                            angle_min   angle_max
79.                                )
80.                                ;;步进没有到第一点插入点
81.                                (WHILE (AND (< dist_start dist_end) ;没有到下一个拟合点
82.                                                        (SETQ point_now (VLAX-CURVE-GETPOINTATPARAM curve-obj dist_start)
83.                                                                    angle_now (ANGLE point_base point_now)
84.                                                        )
85.                                                        (< (SETQ angle_tmp (MAX (ABS (- angle_max angle_now)) (ABS (- angle_min angle_now)))) angle_dlta)
86.                                                                                                    ;角度在限差内
87.                                                        (< (* angle_tmp (DISTANCE point_base point_now)) dist_dlta) ;距离在限差内
88.                                              )
89.                                        (SETQ dist_start (+ dist_start dist_step))
90.                                        (IF (> angle_now angle_max)
91.                                                (SETQ angle_max angle_now)
92.                                                (IF (< angle_now angle_min)
93.                                                        (SETQ angle_min angle_now)
94.                                                )
95.                                        )
96.                                )
97.                                (IF (< (SETQ angle_tmp (MAX (ABS (- angle_max angle_now)) (ABS (- angle_min angle_now)))) angle_dlta)
98.                                        (PRINC "\nangle>")
99.                                )
100.                                (IF (< (* angle_tmp (DISTANCE point_base point_now)) dist_dlta)
101.                                        (PRINC "\ndist>")
102.                                )
103.                                (IF (< dist_start dist_end)
104.                                        (SETQ points_new (CONS point_now points_new))
105.                                )
106.                        )
107.                        (SETQ points_new (CONS (CAR points_old) points_new)
108.                                    points_old (CDR points_old)
109.                        )
110.                )
111.                ;;生成多义线
112.                (COMMAND "pline")
113.                (FOREACH x (REVERSE points_new) (COMMAND x))
114.                (IF (= 1 (LOGAND 1 (CDR (ASSOC '70 data))))
115.                        (COMMAND "u" "c")                                         ;闭合的
116.                        (COMMAND "")
117.                )
118.                ;;删除SPLINE
119.                (ENTDEL ename)
120.        )
121.        (PRINC)
122. )
123. ;;;==================================================================
124. (PRINC)

复制代码

说明:对于距离限差和角度限差，并不能保证在限差范围之内的最大值，只可以保证在允许限差内。
请大家发表保贵意见。

龙龙仔

2. 
   
3. ;;利用OFFSET特性(对SPLINE & ELLIPSE  OFFSET后会增加控制点)
   
4. ;;SPLINE & ELLIPSE TO PLINE
   
5. ;;BY  龙龙仔(LUCAS)
   
6. (defun C:S2P (/        HOLDOSMODE HOLDECHO SSS        SSL N N1 ENT PT_LIST NUMPT ED PT PT1)
   
7.   ;;T. Tanzillo
   
8.   (defun VLISP-REMOVE-IF-NOT (KEY LST)
   
9.     (mapcar 'cdr
   
10.             (vl-remove-if-not
    
11.               '(lambda (E) (eq (car E) KEY))
    
12.               LST
    
13.             )
    
14.     )
    
15.   )
    
16. 
    
17.   (defun MIDPOINT (PT1 PT2)
    
18.     (mapcar
    
19.       '(lambda (X Y)
    
20.          (* 0.5 (+ X Y))
    
21.        )
    
22.       PT1
    
23.       PT2
    
24.     )
    
25.   )
    
26. 
    
27.   (setq HOLDECHO (getvar "cmdecho"))
    
28.   (setvar "cmdecho" 0)
    
29.   (command "_.undo" "group")
    
30.   (setq HOLDOSMODE (getvar "osmode"))
    
31.   (setvar "osmode" 0)
    
32.   (prompt "\n选取SPLINE,ELLIPSE:")
    
33.   (setq SSS (ssget '((0 . "ELLIPSE,SPLINE"))))
    
34.   (setq        SSL (sslength SSS)
    
35.         N   0
    
36.   )
    
37.   (repeat SSL
    
38.     (prompt (strcat "\r余 " (itoa (- SSL N)) " 个物件     "))
    
39.     (setq ENT (vlax-ename->vla-object (ssname SSS N)))
    
40.     (vl-catch-all-apply
    
41.       'vla-offset
    
42.       (list ENT 0.001)
    
43.     )
    
44.     (setq ENT (entlast))
    
45.     (vl-catch-all-apply
    
46.       'vla-offset
    
47.       (list (vlax-ename->vla-object ENT) -0.001)
    
48.     )
    
49.     (entdel ENT)
    
50.     (setq ENT (entlast))
    
51.     (setq PT_LIST (VLISP-REMOVE-IF-NOT 10 (setq ED (entget ENT))))
    
52.     (setq ENT (vlax-ename->vla-object ENT))
    
53.     (setq N1 0)
    
54.     (vl-cmdf "_.pline" (nth N1 PT_LIST) "A")
    
55.     (if        (or (and (= (cdr (assoc 0 ED)) "ELLIPSE")
    
56.                  (= (cdr (assoc 42 ED)) (* pi 2))
    
57.             )
    
58.             (and (= (cdr (assoc 0 ED)) "SPLINE")
    
59.                  (= (logand (cdr (assoc 70 ED)) 1) 1)
    
60.             )
    
61.         )
    
62.       (setq NUMPT (- (length PT_LIST) 2))
    
63.       (setq NUMPT (- (length PT_LIST) 1))
    
64.     )
    
65.     (repeat NUMPT
    
66.       (setq PT (vlax-curve-getclosestpointto
    
67.                  ENT
    
68.                  (MIDPOINT (nth N1 PT_LIST)
    
69.                            (setq PT1 (nth (1+ N1) PT_LIST))
    
70.                  )
    
71.                )
    
72.       )
    
73.       (vl-cmdf "S"
    
74.                (vlax-curve-getclosestpointto ENT PT)
    
75.                (vlax-curve-getclosestpointto ENT PT1)
    
76.       )
    
77.       (setq N1 (1+ N1))
    
78.     )
    
79.     (if        (or (and (= (cdr (assoc 0 ED)) "ELLIPSE")
    
80.                  (= (cdr (assoc 42 ED)) (* pi 2))
    
81.             )
    
82.             (and (= (cdr (assoc 0 ED)) "SPLINE")
    
83.                  (= (logand (cdr (assoc 70 ED)) 1) 1)
    
84.             )
    
85.         )
    
86.       (vl-cmdf "CL")
    
87.       (vl-cmdf "")
    
88.     )
    
89.     (vla-delete ENT)
    
90.     (setq N (1+ N))
    
91.   )
    
92.   (setvar "osmode" HOLDOSMODE)
    
93.   (command "_.undo" "end")
    
94.   (setvar "cmdecho" HOLDECHO)
    
95.   (princ)
    
96. )
    

<br /> ;;利用OFFSET特性(对SPLINE & ELLIPSE  OFFSET后会增加控制点)<br /> ;;SPLINE & ELLIPSE TO PLINE<br /> ;;BY  龙龙仔(LUCAS)<br /> (defun C:S2P (/        HOLDOSMODE HOLDECHO SSS        SSL N N1 ENT PT_LIST NUMPT ED PT PT1)<br />   ;;T. Tanzillo<br />   (defun VLISP-REMOVE-IF-NOT (KEY LST)<br />     (mapcar 'cdr<br />             (vl-remove-if-not<br />               '(lambda (E) (eq (car E) KEY))<br />               LST<br />             )<br />     )<br />   )<br /> <br />   (defun MIDPOINT (PT1 PT2)<br />     (mapcar<br />       '(lambda (X Y)<br />          (* 0.5 (+ X Y))<br />        )<br />       PT1<br />       PT2<br />     )<br />   )<br /> <br />   (setq HOLDECHO (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (command "_.undo" "group")<br />   (setq HOLDOSMODE (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (prompt "\n选取SPLINE,ELLIPSE:")<br />   (setq SSS (ssget '((0 . "ELLIPSE,SPLINE"))))<br />   (setq        SSL (sslength SSS)<br />         N   0<br />   )<br />   (repeat SSL<br />     (prompt (strcat "\r余 " (itoa (- SSL N)) " 个物件     "))<br />     (setq ENT (vlax-ename->vla-object (ssname SSS N)))<br />     (vl-catch-all-apply<br />       'vla-offset<br />       (list ENT 0.001)<br />     )<br />     (setq ENT (entlast))<br />     (vl-catch-all-apply<br />       'vla-offset<br />       (list (vlax-ename->vla-object ENT) -0.001)<br />     )<br />     (entdel ENT)<br />     (setq ENT (entlast))<br />     (setq PT_LIST (VLISP-REMOVE-IF-NOT 10 (setq ED (entget ENT))))<br />     (setq ENT (vlax-ename->vla-object ENT))<br />     (setq N1 0)<br />     (vl-cmdf "_.pline" (nth N1 PT_LIST) "A")<br />     (if        (or (and (= (cdr (assoc 0 ED)) "ELLIPSE")<br />                  (= (cdr (assoc 42 ED)) (* pi 2))<br />             )<br />             (and (= (cdr (assoc 0 ED)) "SPLINE")<br />                  (= (logand (cdr (assoc 70 ED)) 1) 1)<br />             )<br />         )<br />       (setq NUMPT (- (length PT_LIST) 2))<br />       (setq NUMPT (- (length PT_LIST) 1))<br />     )<br />     (repeat NUMPT<br />       (setq PT (vlax-curve-getclosestpointto<br />                  ENT<br />                  (MIDPOINT (nth N1 PT_LIST)<br />                            (setq PT1 (nth (1+ N1) PT_LIST))<br />                  )<br />                )<br />       )<br />       (vl-cmdf "S"<br />                (vlax-curve-getclosestpointto ENT PT)<br />                (vlax-curve-getclosestpointto ENT PT1)<br />       )<br />       (setq N1 (1+ N1))<br />     )<br />     (if        (or (and (= (cdr (assoc 0 ED)) "ELLIPSE")<br />                  (= (cdr (assoc 42 ED)) (* pi 2))<br />             )<br />             (and (= (cdr (assoc 0 ED)) "SPLINE")<br />                  (= (logand (cdr (assoc 70 ED)) 1) 1)<br />             )<br />         )<br />       (vl-cmdf "CL")<br />       (vl-cmdf "")<br />     )<br />     (vla-delete ENT)<br />     (setq N (1+ N))<br />   )<br />   (setvar "osmode" HOLDOSMODE)<br />   (command "_.undo" "end")<br />   (setvar "cmdecho" HOLDECHO)<br />   (princ)<br /> )<br />

无痕

虽然offset的距离很小。但从理论上说，是不是还有不可能正确生成单一新实体的缺陷？