LISP算法该怎么写

yarp

50个单位以下的线段认为是倒角

1. 
   
2. (defun c:tt ( / cut ent )
   
3.   (command "_.undo" "BE")
   
4.   (princ "\n请选择边界")
   
5.   (princ "\n假定50个单位长度以下的线段为切角")
   
6.   (setq cut 50)
   
7.   (setq ent (car (entsel)))
   
8.   (if (eq "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
   
9.     (entsurf ent cut)
   
10.     )
    
11.   (command "_.undo" "E")
    
12.   )
    
13. (defun entsurf (ent cut  /   segment  alpha    bulge    endPoint
    
14.   startPoint   r    br     sr      obj
    
15.   sArea  orArea
    
16.         )
    
17.   (setq eget (entget ent))
    
18.   (setq curList nil
    
19. startPoint
    
20.   nil
    
21. i 0
    
22.   )
    
23.   (foreach segment eget
    
24.     (if (= 42 (car segment))
    
25.       (progn
    
26. (if (= 0.0 (cdr segment))
    
27.    (setq alpha 0.0)
    
28.    (progn
    
29.      (setq bulge (cdr segment))
    
30.      (setq alpha (abs (* 2 (atan bulge))))
    
31.    )
    
32. )
    
33.       )
    
34.     )
    
35.     (if (= 10 (car segment))
    
36.       (progn
    
37. (setq endPoint (cdr segment))
    
38. (if startPoint
    
39.    (progn
    
40.      (setq midPoint (mapcar '(lambda (a b) (/ (+ a b) 2))
    
41.        startPoint
    
42.        endPoint
    
43.       )
    
44.      )
    
45.      (if
    
46.        (or (/= 0.0 alpha) (> cut (distance startPoint endPoint)))
    
47.         (progn
    
48.    (setq dis (distance startPoint endPoint))
    
49.    (if (/= 0.0 alpha)
    
50.      (setq r (/ (* dis 0.5) (sin alpha)))
    
51.      (setq r (- 0 (distance startPoint endPoint)))
    
52.    )
    
53.         )
    
54.         (setq r 0.0)
    
55.      )
    
56.      (setq curList (cons (list r midPoint) curList))
    
57.    )
    
58. )
    
59. (setq startPoint endPoint)
    
60.       )
    
61.     )
    
62.   )
    
63.   (setq len (length curList))
    
64.   (setq firs (car curList))
    
65.   (setq curList (cons (last curList) curList))
    
66.   (setq curList (append curList (list firs)))
    
67.   (while (< (setq i (1+ i)) len)
    
68.     (if (/= 0.0 (car (nth i curList)))
    
69.       (if (> (car (nth i curList)) 0.0)
    
70.       (progn
    
71. (setq r (car (nth i curList)))
    
72. (setq startPoint (cadr (nth (1- i) curList)))
    
73. (setq endPoint (cadr (nth (1+ i) curList)))
    
74. (setq br (+ 1 r))
    
75. ;;大半径和小半径跟据自已的需要定
    
76. (setq sr (+ -1 r))
    
77. (setq obj (vlax-ename->vla-object ent))
    
78. (setq orArea (abs (vla-get-area obj)))
    
79. (vla-update obj)
    
80. (command "_.fillet" "R" sr)
    
81. (command "_.fillet" startPoint endPoint)
    
82. (setq sArea (abs (vla-get-area obj)))
    
83. (vla-update obj)
    
84. (if (> sArea orArea)
    
85.    (progn
    
86.      (command "_.fillet" "R" br)
    
87.      (command "_.fillet" startPoint endPoint)
    
88.    )
    
89. )
    
90.       )
    
91. (progn
    
92. (setq r (* -0.707107 (car (nth i curList))))
    
93. (setq startPoint (cadr (nth (1- i) curList)))
    
94. (setq endPoint (cadr (nth (1+ i) curList)))
    
95. (setq br (+ 1 r))
    
96. ;;大半径和小半径跟据自已的需要定
    
97. (setq sr (+ -1 r))
    
98. (setq obj (vlax-ename->vla-object ent))
    
99. (setq orArea (abs (vla-get-area obj)))
    
100. (vla-update obj)
     
101. (command "_.chamfer" "D" sr sr)
     
102. (command "_.chamfer" startPoint endPoint)
     
103. (setq sArea (abs (vla-get-area obj)))
     
104. (vla-update obj)
     
105. (if (> sArea orArea)
     
106.    (progn
     
107.      (command "_.chamfer" "D" br br)
     
108.      (command "_.chamfer" startPoint endPoint)
     
109.    )
     
110. )
     
111.       )
     
112. )
     
113.     )
     
114.   )     ;progn
     
115. )
     
116. 
     
117. 
     

<br /> (defun c:tt ( / cut ent )<br />   (command "_.undo" "BE")<br />   (princ "\n请选择边界")<br />   (princ "\n假定50个单位长度以下的线段为切角")<br />   (setq cut 50)<br />   (setq ent (car (entsel)))<br />   (if (eq "LWPOLYLINE" (cdr (assoc 0 (entget ent))))<br />     (entsurf ent cut)<br />     )<br />   (command "_.undo" "E")<br />   )<br /> (defun entsurf (ent cut  /   segment  alpha    bulge    endPoint<br />   startPoint   r    br     sr      obj<br />   sArea  orArea<br />         )<br />   (setq eget (entget ent))<br />   (setq curList nil<br /> startPoint<br />   nil<br /> i 0<br />   )<br />   (foreach segment eget<br />     (if (= 42 (car segment))<br />       (progn<br /> (if (= 0.0 (cdr segment))<br />    (setq alpha 0.0)<br />    (progn<br />      (setq bulge (cdr segment))<br />      (setq alpha (abs (* 2 (atan bulge))))<br />    )<br /> )<br />       )<br />     )<br />     (if (= 10 (car segment))<br />       (progn<br /> (setq endPoint (cdr segment))<br /> (if startPoint<br />    (progn<br />      (setq midPoint (mapcar '(lambda (a b) (/ (+ a b) 2))<br />        startPoint<br />        endPoint<br />       )<br />      )<br />      (if<br />        (or (/= 0.0 alpha) (> cut (distance startPoint endPoint)))<br />         (progn<br />    (setq dis (distance startPoint endPoint))<br />    (if (/= 0.0 alpha)<br />      (setq r (/ (* dis 0.5) (sin alpha)))<br />      (setq r (- 0 (distance startPoint endPoint)))<br />    )<br />         )<br />         (setq r 0.0)<br />      )<br />      (setq curList (cons (list r midPoint) curList))<br />    )<br /> )<br /> (setq startPoint endPoint)<br />       )<br />     )<br />   )<br />   (setq len (length curList))<br />   (setq firs (car curList))<br />   (setq curList (cons (last curList) curList))<br />   (setq curList (append curList (list firs)))<br />   (while (< (setq i (1+ i)) len)<br />     (if (/= 0.0 (car (nth i curList)))<br />       (if (> (car (nth i curList)) 0.0)<br />       (progn<br /> (setq r (car (nth i curList)))<br /> (setq startPoint (cadr (nth (1- i) curList)))<br /> (setq endPoint (cadr (nth (1+ i) curList)))<br /> (setq br (+ 1 r))<br /> ;;大半径和小半径跟据自已的需要定<br /> (setq sr (+ -1 r))<br /> (setq obj (vlax-ename->vla-object ent))<br /> (setq orArea (abs (vla-get-area obj)))<br /> (vla-update obj)<br /> (command "_.fillet" "R" sr)<br /> (command "_.fillet" startPoint endPoint)<br /> (setq sArea (abs (vla-get-area obj)))<br /> (vla-update obj)<br /> (if (> sArea orArea)<br />    (progn<br />      (command "_.fillet" "R" br)<br />      (command "_.fillet" startPoint endPoint)<br />    )<br /> )<br />       )<br /> (progn<br /> (setq r (* -0.707107 (car (nth i curList))))<br /> (setq startPoint (cadr (nth (1- i) curList)))<br /> (setq endPoint (cadr (nth (1+ i) curList)))<br /> (setq br (+ 1 r))<br /> ;;大半径和小半径跟据自已的需要定<br /> (setq sr (+ -1 r))<br /> (setq obj (vlax-ename->vla-object ent))<br /> (setq orArea (abs (vla-get-area obj)))<br /> (vla-update obj)<br /> (command "_.chamfer" "D" sr sr)<br /> (command "_.chamfer" startPoint endPoint)<br /> (setq sArea (abs (vla-get-area obj)))<br /> (vla-update obj)<br /> (if (> sArea orArea)<br />    (progn<br />      (command "_.chamfer" "D" br br)<br />      (command "_.chamfer" startPoint endPoint)<br />    )<br /> )<br />       )<br /> )<br />     )<br />   )     ;progn<br /> )<br /> <br /> <br />

QUAN2518

回复 yarp 的帖子

感谢你的代码。
测试还有点小问题，我自己解读下看看先。
还有C角的判定可能需要假如相邻两段为直线，不然出现小与5的线段可能会有益处问题。