Author Topic: [XDrX-PlugIn(96)] TopoL(1) -- Point-edge distance topology check  (Read 285 times)

0 Members and 1 Guest are viewing this topic.

xdcad

  • Bull Frog
  • Posts: 469
Checks if there is a point whose distance to a polygon edge is less than the tolerance

Code - Auto/Visual Lisp: [Select]
  1. (defun c:xdtb_topochkptedge
  2.                             (/      dis    e      i      inx    lst
  3.                              np     nums   pt     result ss     var
  4.                              verts  x      #i     #ents  #incheck
  5.                              #check-pt
  6.                             )
  7.   (defun xd::list:intarrays (from to / arrs i)
  8.     (if (< to from)
  9.       (setq temp to
  10.             to   from
  11.             from temp
  12.       )
  13.     )
  14.     (setq i from)
  15.     (while (<= i to)
  16.       (setq arrs (cons i arrs)
  17.             i    (1+ i)
  18.       )
  19.     )
  20.     (reverse arrs)
  21.   )
  22.   (defun _callback (dynpt)
  23.     (redraw)
  24.     (mapcar '(lambda (x) (xdrx_grdraw 2 0 x 4 4)) result)
  25.     (if #incheck
  26.       (progn
  27.         (xd::doc:drawcrosshair #check-pt (/ pi 4) 0.04)
  28.       )
  29.     )
  30.   )
  31.   (xdrx_begin)
  32.   (if (not xd_var_global_tol)
  33.     (setq xd_var_global_tol 0.01)
  34.   )
  35.   (if (setq
  36.         var (getreal
  37.               (xdrx_prompt
  38.                 (xdrx-string-formatex
  39.                   (xdrx-string-multilanguage
  40.                     "\n&#36317;&#31163;&#23481;&#24046;&#31934;&#24230;<%.2f>:"
  41.                     "\nDistance tolerance<%.2f>:"
  42.                   )
  43.                   xd_var_global_tol
  44.                 )
  45.                 t
  46.               )
  47.             )
  48.       )
  49.     (setq xd_var_global_tol var)
  50.   )
  51.   (if
  52.     (setq ss (xdrx_ssget
  53.                (xdrx-string-multilanguage
  54.                  "\n&#36873;&#25321;&#35201;&#26816;&#26597;&#30340;&#22810;&#27573;&#32447;<&#36864;&#20986;>:"
  55.                  "\nSelect polylines to inspect <Exit>:"
  56.                )
  57.                '((0 . "*polyline"))
  58.              )
  59.     )
  60.      (progn
  61.        (setq result nil)
  62.        (mapcar
  63.          '(lambda (x)
  64.             (setq nums  (xdrx_getpropertyvalue x "numverts")
  65.                   verts (xd::list:intarrays 0 nums)
  66.             )
  67.             (setq i 0)
  68.             (repeat nums
  69.               (setq np  (xdrx_getpropertyvalue x "-index+" i)
  70.                     np  (list (car np) i)
  71.                     lst (xd::list:removee2 np verts t)
  72.                     tf  t
  73.               )
  74.               (while (and tf (setq inx (car lst)))
  75.                 (if (not (setq e (xdrx_polyline_getlinesegat x inx t)))
  76.                   (setq e (xdrx_polyline_getarcsegat x inx t))
  77.                 )
  78.                 (if e
  79.                   (progn (setq
  80.                            dis (xdge::getpropertyvalue
  81.                                  e
  82.                                  "distanceto"
  83.                                  (setq pt (xdrx_polyline_getpointat x i))
  84.                                )
  85.                          )
  86.                          (if (< dis xd_var_global_tol)
  87.                            (progn (setq result (cons pt result)
  88.                                         tf     nil
  89.                                         #ents  (cons x #ents)
  90.                                   )
  91.                            )
  92.                          )
  93.                          (xdrx_object_release e)
  94.                   )
  95.                 )
  96.                 (setq lst (cdr lst))
  97.               )
  98.               (setq i (1+ i))
  99.             )
  100.           )
  101.          (xdrx_pickset->ents ss)
  102.        )
  103.        (if result
  104.          (progn
  105.            (xdrx_prompt
  106.              (xdrx-string-formatex
  107.                (xdrx-string-multilanguage
  108.                  "\n>>&#28857;&#36793;&#36317;&#31163;&#25299;&#25169;&#26816;&#26597;&#23436;&#27605;.\n  &#20849;&#21457;&#29616; %d &#20010;&#22810;&#36793;&#24418;&#39030;&#28857;&#36317;&#31163;&#20854;&#20182;&#36793;&#36317;&#31163;&#23567;&#20110;&#23481;&#24046;&#20540; %.2f."
  109.                  "\n>>Point-edge distance topology check completed.\n A total of %d polygon vertices were found to be less than the tolerance value %.2f from other edges."
  110.                )
  111.                (length result)
  112.                xd_var_global_tol
  113.              )
  114.            )
  115.            (xdrx_pointmonitor "_callback")
  116.            (setq tf t
  117.                  #i 0
  118.            )
  119.            (while (and tf
  120.                        (xdrx_initget "F S")
  121.                        (setq pt
  122.                               (getpoint
  123.                                 (xdrx-string-multilanguage
  124.                                   "\n&#32553;&#25918;&#23631;&#24149;&#26597;&#30475;[&#26597;&#30475;&#19979;&#19968;&#20010;(S)/&#29983;&#25104;&#22278;(F)]:"
  125.                                   "\nZoom the screen to view [View next(S)/Generate circle(F)]:"
  126.                                 )
  127.                               )
  128.                        )
  129.                   )
  130.              (progn
  131.                (cond ((= pt "F")
  132.                       (setq dis (/ xd_var_global_tol 5.0))
  133.                       (if (setq var
  134.                                  (getreal (xdrx_prompt
  135.                                             (xdrx-string-formatex
  136.                                               (xdrx-string-multilanguage
  137.                                                 "\n&#22278;&#21322;&#24452;<%.2f>:"
  138.                                                 "\nCircle radius<%.2f>:"
  139.                                               )
  140.                                               dis
  141.                                             )
  142.                                             t
  143.                                           )
  144.                                  )
  145.                           )
  146.                         (setq dis var)
  147.                       )
  148.                       (redraw)
  149.                       (xdrx_entity_setproperty
  150.                         (xdrx_circle_make (cons dis result))
  151.                         "color"
  152.                         2
  153.                         "layer"
  154.                         (xdrx-string-multilanguage
  155.                           "&#25299;&#25169;&#26680;&#26597;"
  156.                           "Topology Verification"
  157.                         )
  158.                       )
  159.                      )
  160.                      ((= pt "S")
  161.                       (if (setq e (nth #i #ents))
  162.                         (progn
  163.                           (setq #incheck  t
  164.                                 #check-pt (nth #i result)
  165.                           )
  166.                           (xdrx_document_zoomentities e 0.8)
  167.                           (setq #i (1+ #i))
  168.                         )
  169.                         (progn
  170.                           (setq #incheck nil)
  171.                           (xdrx_prompt
  172.                             (xdrx-string-multilanguage
  173.                               "\n>>&#24050;&#32463;&#26597;&#30475;&#23436;&#25152;&#26377;&#22810;&#36793;&#24418;."
  174.                               "\n>>All polygons have been viewed."
  175.                             )
  176.                           )
  177.                           (setq #i 0)
  178.                           (xdrx_document_zoomentities #ents 0.8)
  179.                         )
  180.                       )
  181.                      )
  182.                      (t (setq tf nil))
  183.                )
  184.              )
  185.            )
  186.            (xdrx_pointmonitor)
  187.          )
  188.          (xdrx_prompt
  189.            (xdrx-string-formatex
  190.              (xdrx-string-multilanguage
  191.                "\n&#28857;&#36793;&#36317;&#31163;&#25299;&#25169;&#26816;&#26597;&#23436;&#27605;&#65292;&#27809;&#21457;&#29616;&#36317;&#31163;&#20854;&#20182;&#36793;&#36317;&#31163;&#23567;&#20110;&#23481;&#24046;&#20540; %.2f &#30340;&#39030;&#28857;."
  192.                "\nThe point-edge distance topology check is completed, and no vertices whose distances from other edges are less than the tolerance value %.2f were found."
  193.              )
  194.              xd_var_global_tol
  195.            )
  196.          )
  197.        )
  198.      )
  199.   )
  200.   (xdrx_end)
  201.   (princ)
  202. )

 edit Kerry : [ code=cadlisp-7 ]
« Last Edit: January 19, 2024, 06:40:36 PM by kdub_nz »
The code I wrote uses XDRX-API,which can be downloaded from github.com and is updated at any time.
===================================
[XDrx-Sub Forum]
https://www.theswamp.org/index.php?board=78.0
https://github.com/xdcad/XDrx-API
http://bbs.xdcad.net