(已自行解决)大神麻烦如何抽稀线段不失真,圆弧只要起点中点终点三点就好

song宋_74729

如何抽稀线段不失真,圆弧段只要起点中点终点三点就好

guosheyang

圆弧变成三点，其他非圆弧咋取点，要有详细的抽稀

规则

song宋_74729

guosheyang 发表于 2022-4-19 14:24
圆弧变成三点，其他非圆弧咋取点，要有详细的抽稀

规则

圆弧段就好

guosheyang

那识别出圆弧  然后改成两线段就可以了

song宋_74729

guosheyang 发表于 2022-4-19 16:37
那识别出圆弧  然后改成两线段就可以了

没错 识别出圆弧  然后改成两线段

song宋_74729

song宋_74729 发表于 2022-4-19 17:29
没错 识别出圆弧  然后改成两线段

2. (defun cutpoint        (ptsnew / pt0 pt1 pt2 pt3 pt4 dist0 dist1 dist2 ang1 ang2 len) ;    Τ拜  
   
3.   (setq        len    (- (length ptsnew) 4)
   
4.         pt0    (car ptsnew)
   
5.         ptsnew (cdr ptsnew)
   
6.         pt1    (car ptsnew)
   
7.         ptsnew (cdr ptsnew)
   
8.         pt2    (car ptsnew)
   
9.         ptsnew (cdr ptsnew)
   
10.         pt3    (car ptsnew)
    
11.         ptsnew (cdr ptsnew)
    
12.         return (list pt1 pt0)
    
13.         dist0  (distance pt0 pt1)
    
14.   )
    
15.   (repeat len
    
16.     (setq pt4         (car ptsnew)
    
17.           ptsnew (cdr ptsnew)
    
18.           dist1         (distance pt1 pt3)
    
19.           dist2         (distance pt3 pt4)
    
20.     )
    
21.     (if        (and (> dist1 0) (> (/ dist0 dist1) 0.3) (< (/ dist0 dist1) 3))
    
22.       (setq ang1 ang)
    
23.       (setq ang1 (/ ang 2))
    
24.     )
    
25.     (if        (and (> dist2 0) (> (/ dist1 dist2) 0.3) (< (/ dist1 dist2) 3))
    
26.       (setq ang2 ang)
    
27.       (setq ang2 (/ ang 2))
    
28.     )
    
29.     (if        (and (< dist1 dist_max) (corner pt0 pt1 pt3 ang1) (corner pt1 pt3 pt4 ang2))
    
30.       t
    
31.       (setq return (cons pt2 return)
    
32.             dist0  (distance pt2 pt1)
    
33.             pt0           pt1
    
34.             pt1           pt2
    
35.       )
    
36.     )
    
37.     (setq pt2 pt3)
    
38.     (setq pt3 pt4)
    
39.   )
    
40.   (apply 'append (cons pt4 (cons pt2 return)))
    
41. )
    
42. 
    
43. (defun corner (c_p1 c_p2 c_p3 c_an / c_1 c_2 temp)
    
44.   (setq        c_1 (angle c_p2 c_p1)
    
45.         c_2 (angle c_p2 c_p3)
    
46.   )
    
47.   (if (< c_1 c_2)
    
48.     (setq temp (abs (- c_2 c_1 pi)))
    
49.     (setq temp (abs (- c_1 c_2 pi)))
    
50.   )
    
51.   (<= temp c_an)
    
52. )
    
53. (defun poly_pts        (points / po_pts po_pt)
    
54.   (setq        po_pts (list (list (car points) (cadr points) 0)))
    
55.   (setq points (cdddr points))
    
56.   (while points
    
57.     (setq po_pt         (list (car points) (cadr points) 0))
    
58.     (setq points (cdddr points))
    
59.     (if        (> (distance (car po_pts) po_pt) dist_min)
    
60.       (setq po_pts (cons po_pt po_pts))
    
61.     )
    
62.   )
    
63.   (setq po_pts (cons po_pt po_pts))
    
64.   (if (> (length po_pts) 4)
    
65.     (cutpoint po_pts)
    
66.   )
    
67. )
    
68. (defun lwpoly_pts (points / lw_pts lw_pt)
    
69.   (setq lw_pts (list (list (car points) (cadr points))))
    
70.   (setq points (cddr points))
    
71.   (while points
    
72.     (setq lw_pt         (list (car points) (cadr points)))
    
73.     (setq points (cddr points))
    
74.     (if        (> (distance (car lw_pts) lw_pt) dist_min)
    
75.       (setq lw_pts (cons lw_pt lw_pts))
    
76.     )
    
77.   )
    
78.   (setq lw_pts (cons lw_pt lw_pts))
    
79.   (if (> (length lw_pts) 4)
    
80.     (cutpoint lw_pts)
    
81.   )
    
82. )
    
83. (defun c:choudian (/ layers dist_min dist_max ang ss m n ename object points ptsnew)
    
84.   (setq layers (layer_names))
    
85.   (if (= (getvar "plinetype") 2)
    
86.     (setq ss (ssget (list (cons 0 "lwpolyline") (cons 8 layers))))
    
87.     (setq ss (ssget (list (cons 0 "polyline") (cons 8 layers))))
    
88.   )
    
89.   (if ss
    
90.     (progn
    
91.       (setvar "cmdecho" 0)
    
92.       (command "undo" "g")
    
93.       (initget 6)
    
94.       (if (setq dist_min (getreal "请输入最小步长:<1>"))
    
95.         (setq dist_max (* dist_min 30))
    
96.         (setq dist_min 1
    
97.               dist_max (* dist_min 30)
    
98.         )
    
99.       )
    
100.       (initget 6)
     
101.       (if (null (setq ang (getorient "请输入最大转角:<12度>")))
     
102.         (setq ang 0.21)
     
103.       )
     
104.       (setq m (sslength ss)
     
105.             n (1- m)
     
106.       )
     
107.       (repeat m
     
108.         (print n)
     
109.         (setq ename  (ssname ss n)
     
110.               n             (1- n)
     
111.               object (vlax-ename->vla-object ename)
     
112.               pts_li (vla-get-Coordinates object)
     
113.         )
     
114.         (if (= (getvar "plinetype") 2)
     
115.           (setq ptsnew (lwpoly_pts pts_li))
     
116.           (setq ptsnew (poly_pts pts_li))
     
117.         )
     
118.         (if (> (length ptsnew) 5)
     
119.           (progn
     
120.             (vla-put-Coordinates object ptsnew)
     
121.             (command "pedit" ename "w" (cdr (assoc 40 (entget ename))) "")
     
122.           )
     
123.         )
     
124.         (vlax-release-object object)
     
125.       )
     
126.       (command "undo" "e")
     
127.       (prin1)
     
128.     )
     
129.   )
     
130. )

(defun cutpoint        (ptsnew / pt0 pt1 pt2 pt3 pt4 dist0 dist1 dist2 ang1 ang2 len) ;    Τ拜  <br />   (setq        len    (- (length ptsnew) 4)<br />         pt0    (car ptsnew)<br />         ptsnew (cdr ptsnew)<br />         pt1    (car ptsnew)<br />         ptsnew (cdr ptsnew)<br />         pt2    (car ptsnew)<br />         ptsnew (cdr ptsnew)<br />         pt3    (car ptsnew)<br />         ptsnew (cdr ptsnew)<br />         return (list pt1 pt0)<br />         dist0  (distance pt0 pt1)<br />   )<br />   (repeat len<br />     (setq pt4         (car ptsnew)<br />           ptsnew (cdr ptsnew)<br />           dist1         (distance pt1 pt3)<br />           dist2         (distance pt3 pt4)<br />     )<br />     (if        (and (> dist1 0) (> (/ dist0 dist1) 0.3) (< (/ dist0 dist1) 3))<br />       (setq ang1 ang)<br />       (setq ang1 (/ ang 2))<br />     )<br />     (if        (and (> dist2 0) (> (/ dist1 dist2) 0.3) (< (/ dist1 dist2) 3))<br />       (setq ang2 ang)<br />       (setq ang2 (/ ang 2))<br />     )<br />     (if        (and (< dist1 dist_max) (corner pt0 pt1 pt3 ang1) (corner pt1 pt3 pt4 ang2))<br />       t<br />       (setq return (cons pt2 return)<br />             dist0  (distance pt2 pt1)<br />             pt0           pt1<br />             pt1           pt2<br />       )<br />     )<br />     (setq pt2 pt3)<br />     (setq pt3 pt4)<br />   )<br />   (apply 'append (cons pt4 (cons pt2 return)))<br /> )<br /> <br /> (defun corner (c_p1 c_p2 c_p3 c_an / c_1 c_2 temp)<br />   (setq        c_1 (angle c_p2 c_p1)<br />         c_2 (angle c_p2 c_p3)<br />   )<br />   (if (< c_1 c_2)<br />     (setq temp (abs (- c_2 c_1 pi)))<br />     (setq temp (abs (- c_1 c_2 pi)))<br />   )<br />   (<= temp c_an)<br /> )<br /> (defun poly_pts        (points / po_pts po_pt)<br />   (setq        po_pts (list (list (car points) (cadr points) 0)))<br />   (setq points (cdddr points))<br />   (while points<br />     (setq po_pt         (list (car points) (cadr points) 0))<br />     (setq points (cdddr points))<br />     (if        (> (distance (car po_pts) po_pt) dist_min)<br />       (setq po_pts (cons po_pt po_pts))<br />     )<br />   )<br />   (setq po_pts (cons po_pt po_pts))<br />   (if (> (length po_pts) 4)<br />     (cutpoint po_pts)<br />   )<br /> )<br /> (defun lwpoly_pts (points / lw_pts lw_pt)<br />   (setq lw_pts (list (list (car points) (cadr points))))<br />   (setq points (cddr points))<br />   (while points<br />     (setq lw_pt         (list (car points) (cadr points)))<br />     (setq points (cddr points))<br />     (if        (> (distance (car lw_pts) lw_pt) dist_min)<br />       (setq lw_pts (cons lw_pt lw_pts))<br />     )<br />   )<br />   (setq lw_pts (cons lw_pt lw_pts))<br />   (if (> (length lw_pts) 4)<br />     (cutpoint lw_pts)<br />   )<br /> )<br /> (defun c:choudian (/ layers dist_min dist_max ang ss m n ename object points ptsnew)<br />   (setq layers (layer_names))<br />   (if (= (getvar "plinetype") 2)<br />     (setq ss (ssget (list (cons 0 "lwpolyline") (cons 8 layers))))<br />     (setq ss (ssget (list (cons 0 "polyline") (cons 8 layers))))<br />   )<br />   (if ss<br />     (progn<br />       (setvar "cmdecho" 0)<br />       (command "undo" "g")<br />       (initget 6)<br />       (if (setq dist_min (getreal "请输入最小步长:<1>"))<br />         (setq dist_max (* dist_min 30))<br />         (setq dist_min 1<br />               dist_max (* dist_min 30)<br />         )<br />       )<br />       (initget 6)<br />       (if (null (setq ang (getorient "请输入最大转角:<12度>")))<br />         (setq ang 0.21)<br />       )<br />       (setq m (sslength ss)<br />             n (1- m)<br />       )<br />       (repeat m<br />         (print n)<br />         (setq ename  (ssname ss n)<br />               n             (1- n)<br />               object (vlax-ename->vla-object ename)<br />               pts_li (vla-get-Coordinates object)<br />         )<br />         (if (= (getvar "plinetype") 2)<br />           (setq ptsnew (lwpoly_pts pts_li))<br />           (setq ptsnew (poly_pts pts_li))<br />         )<br />         (if (> (length ptsnew) 5)<br />           (progn<br />             (vla-put-Coordinates object ptsnew)<br />             (command "pedit" ename "w" (cdr (assoc 40 (entget ename))) "")<br />           )<br />         )<br />         (vlax-release-object object)<br />       )<br />       (command "undo" "e")<br />       (prin1)<br />     )<br />   )<br /> )

明经cad找到这,麻烦优化  谢谢