Topic: [XDrX-PlugIn(39)] Specify tolerance polyline curvature

[xdcad]

Code - Auto/Visual Lisp: [Select]

1. (defun c:tt ()
2.   (defun _remove-arc ()
3.     (setq cinx (vl-position seg segs))
4.     (setq prevseg (nth (1- cinx) segs)
5.           nextseg (nth (1+ cinx) segs)
6.     )
7.     (if (and (xdrx-object-iskindof prevseg "kLineSeg3d")
8.              (xdrx-object-iskindof nextseg "kLineSeg3d")
9.         )
10.       (progn
11.         (if (setq ints (xdrx-entity-intersectwith prevseg nextseg 3))
12.           (progn
13.             (setq ints (car ints))
14.             (xdrx-setpropertyvalue poly "removevertexat" inx)
15.             (xdrx-setpropertyvalue poly "pointat" (list inx ints))
16.             t
17.           )
18.         )
19.       )
20.     )
21.   )
22.   (defun _process (poly)
23.     (if (not (xdrx-getpropertyvalue poly "isOnlyLines"))
24.       (progn
25.         (setq segs (xdrx-getpropertyvalue poly "allsegs"))
26.         (setq inx 0)
27.         (foreach seg segs
28.           (if (xdrx-object-iskindof seg "kCircArc3d")
29.             (progn
30.               (setq radius (xdrx-getpropertyvalue seg "radius"))
31.               (if (< radius #xd-var-poly-arc-radius)
32.                 (progn
33.                   (_remove-arc)
34.                   (setq inx (1- inx))
35.                 )
36.               )
37.             )
38.           )
39.           (setq inx (1+ inx))
40.         )
41.       )
42.     )
43.   )
44.  
45.   ;main program
46.  
47.   (xdrx-begin)
48.   (if (not #xd-var-poly-arc-radius)
49.     (setq #xd-var-poly-arc-radius 1.0)
50.   )
51.   (if (setq temp
52.              (getreal
53.                (xdrx-string-format
54.                  "\nPlease output the recurvature radius tolerance <%0.1f>:"
55.                  #xd-var-poly-arc-radius
56.                )
57.              )
58.       )
59.     (setq #xd-var-poly-arc-radius temp)
60.   )
61.   (if (setq ss (xdrx-ssget
62.                  "\nSelect the polyline to be recurved<Exit>:"
63.                  '((0 . "*polyline"))
64.                )
65.       )
66.     (mapcar '(lambda (poly)
67.                (_process poly)
68.              )
69.             (xdrx-ss->ents ss)
70.     )
71.   )
72.   (xdrx-end)
73.   (princ)
74. )