Author Topic: [XDrX-PlugIn(39)] Specify tolerance polyline curvature  (Read 790 times)

0 Members and 1 Guest are viewing this topic.

xdcad

  • Swamp Rat
  • Posts: 527
[XDrX-PlugIn(39)] Specify tolerance polyline curvature
« on: December 10, 2023, 11:50:05 AM »
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. )
The code I wrote uses XDRX-API,which can be downloaded from github.com and is updated at any time.
===================================
https://github.com/xdcad
https://sourceforge.net/projects/xdrx-api-zip/
http://bbs.xdcad.net