Author Topic: [XDrX-PlugIn(98)] [Topol(3)]- Polygons whose distance is less than the tolerance  (Read 243 times)

0 Members and 1 Guest are viewing this topic.

xdcad

  • Bull Frog
  • Posts: 469
[Topology Check] Polygons whose distance is less than the tolerance, do not intersect, do not fit, and have no gaps, but the distance is less than the tolerance

Code - Auto/Visual Lisp: [Select]
  1. ;|
  2. Plugin name: Distance Tolerance Polygon
  3. Author: XDSoft
  4. Running environment: XDRX API OpenDCL Xiaodong toolbox
  5. Release time: 2024-01-20
  6. Command name: xdtb_topochktoldist
  7. Plug-in introduction: [Topology Check] Polygons whose distance is less than the tolerance, do not intersect, do not fit, and have no gaps, but the distance is less than the tolerance
  8. |;
  9. (defun c:xdtb_topochktoldist (/ #i box cen1 cen cen2 cens cenx e ents ents1 h ii nums pt ss ss1 tf var w x y myerr epoly e1 txth
  10.                                 dist pnt context vs cir1 cir2 #mem_text #ents_pair
  11.                                )
  12.   (defun myerr (msg)
  13.     (redraw)
  14.     (xdrx_pointmonitor)
  15.     (xdrx_sysvar_pop)
  16.     (setq *error* olderr)
  17.     (xdrx-end)
  18.     (princ)
  19.   )
  20.   (defun _callback (dynpt / e1)
  21.     (if (setq e1 (car epoly))
  22.       (progn (redraw)
  23.              (xdrx-getpropertyvalue e "startpoint" "endpoint")
  24.              (xd::doc:drawcrosshair #startpoint (/ pi 4) 0.03)
  25.              (xd::doc:drawcrosshair #endpoint (/ pi 4) 0.03)
  26.              (setq cen     (xdrx_getpropertyvalue e1 "centroid")
  27.                    vs      (getvar "viewsize")
  28.                    cen     (mapcar '+
  29.                                    cen
  30.                                    (xdrx-vector-product (getvar "ucsydir") (* vs 0.05))
  31.                            )
  32.                    txth    (* vs 0.02)
  33.                    dist    (xdrx-getpropertyvalue (car epoly)
  34.                                                   "distanceto"
  35.                                                   (cadr epoly)
  36.                            )
  37.                    pnt     (xdrx-getpropertyvalue (car epoly)
  38.                                                   "closestpointto"
  39.                                                   (cadr epoly)
  40.                            )
  41.                    context (xdrx-string-formatex (xdrx-string-multilanguage "距离容差:%.2f\n当前间距:%.2f"
  42.                                                                             "Distance Tol:%.2f\nCurrent  Gap:%.2f"
  43.                                                  )
  44.                                                  #xd_var_global_tol
  45.                                                  dist
  46.                            )
  47.              )
  48.              (xdrx-grdraw 9 pnt)
  49.              (xdrx-setpropertyvalue cir1
  50.                                     "center"
  51.                                     (car pnt)
  52.                                     "radius"
  53.                                     (* 0.005 vs)
  54.              )
  55.              (xdrx-setpropertyvalue cir2
  56.                                     "center"
  57.                                     (cadr pnt)
  58.                                     "radius"
  59.                                     (* 0.005 vs)
  60.              )
  61.              (xdrx-grdraw 9 (list cir1 cir2))
  62.              (xd::grdraw:drawtext #mem-text
  63.                                   context
  64.                                   cen
  65.                                   2
  66.                                   txth
  67.                                   9
  68.                                   (getvar "ucsxdir")
  69.                                   t
  70.                                   9
  71.              )
  72.       )
  73.     )
  74.   )
  75.   (xdrx_begin)
  76.   (setq olderr  *error*
  77.         *error* myerr
  78.   )
  79.   (if (not #xd_var_global_tol)
  80.     (setq #xd_var_global_tol 0.1)
  81.   )
  82.   (if (setq var (getreal
  83.                   (xdrx_prompt (xdrx-string-formatex (xdrx-string-multilanguage "\n&#36317;&#31163;&#23481;&#24046;<%.2f>:"
  84.                                                                                 "\nDistance tolerance<%.2f>"
  85.                                                      )
  86.                                                      #xd_var_global_tol
  87.                                )
  88.                                t
  89.                   )
  90.                 )
  91.       )
  92.     (setq #xd_var_global_tol var)
  93.   )
  94.   (if (not #xd_var_global_topo_mark_height)
  95.     (setq #xd_var_global_topo_mark_height 3.0)
  96.   )
  97.   (if (setq var (getreal
  98.                   (xdrx_prompt (xdrx-string-formatex (xdrx-string-multilanguage "\n&#26631;&#35760;&#32447;&#23485;&#24230;<%.1f>:"
  99.                                                                                 "\nMarker line width<%.1f>:"
  100.                                                      )
  101.                                                      #xd_var_global_topo_mark_height
  102.                                )
  103.                                t
  104.                   )
  105.                 )
  106.       )
  107.     (setq #xd_var_global_topo_mark_height var)
  108.   )
  109.   (setq #ents nil)
  110.   (xdrx_sysvar_push (list (list "toldist" #xd_var_global_tol)
  111.                           '("boxfillet" 1)
  112.                           '("boxclosed" 0)
  113.                     )
  114.   )
  115.   (if (setq ss (xdrx_ssget (xdrx-string-multilanguage "\n&#36873;&#25321;&#35201;&#26816;&#26597;&#30340;&#22810;&#27573;&#32447;<&#36864;&#20986;>:"
  116.                                                       "\nSelect polylines to inspect <Exit>:"
  117.                            )
  118.                            '((0 . "*polyline") (-4 . "&=") (70 . 1))
  119.                )
  120.       )
  121.     (progn
  122.       (setq ents (xdrx_pickset->ents ss))
  123.       (xdrx-document-safezoom ss t)
  124.       (setq cens nil
  125.             #ents nil
  126.       )
  127.       (xdrx_entity_delete
  128.         (ssget "cp"
  129.                (xdrx_entity_box ss)
  130.                (list '(0 . "*polyline")
  131.                      (cons 8
  132.                            (xdrx-string-multilanguage "&#25299;&#25169;&#26680;&#26597;"
  133.                                                       "Topology Verification"
  134.                            )
  135.                      )
  136.                      '(62 . 4)
  137.                )
  138.         )
  139.       )
  140.       (xd::odcl:progress-begin ""
  141.                                (xdrx-string-multilanguage "&#27491;&#22312;&#25628;&#32034;&#32541;&#38553;&#30340;&#22810;&#36793;&#24418;"
  142.                                                           "Searching polygons for gaps"
  143.                                )
  144.                                1
  145.                                392
  146.                                24
  147.                                4
  148.                                0
  149.                                (length ents)
  150.       )
  151.       (setq ii 0
  152.             nums 0
  153.             #fengxis nil
  154.       )
  155.       (setq #ents_pair nil)
  156.       (mapcar '(lambda (x)
  157.                  (xd::odcl:progress-setpos1 (setq ii (1+ ii)) 1)
  158.                  (xd::odcl:progress-settext
  159.                    (xdrx-string-formatex (xdrx-string-multilanguage "&#27491;&#22312;&#25628;&#32034;&#32541;&#38553;&#30340;&#22810;&#36793;&#24418;(%d of %d)"
  160.                                                                     "Searching for gap polygons (%d of %d)"
  161.                                          )
  162.                                          ii
  163.                                          (length ents)
  164.                    )
  165.                  )
  166.                  (setq cen   (xdrx_getpropertyvalue x "centroid")
  167.                        cen   (trans cen 0 1)
  168.                        verts (xdrx-getpropertyvalue x "vertices")
  169.                        verts (xdrx-points-compress verts)
  170.                        box   (xdrx-points-offset #xd_var_global_tol verts)
  171.                  )
  172.                  (if (and (setq ss1 (ssget "cp" box '((0 . "*polyline") (-4 . "&=") (70 . 1))))
  173.                           (ssdel x ss1)
  174.                           (> (sslength ss1) 0)
  175.                      )
  176.                    (progn (setq ents1 nil)
  177.                           (mapcar '(lambda (x)
  178.                                      (if (member x ents)
  179.                                        (setq ents1 (cons x ents1))
  180.                                      )
  181.                                    )
  182.                                   (xdrx_pickset->ents ss1)
  183.                           )
  184.                           (mapcar '(lambda (y)
  185.                                      (if (= XD:kOutsideTol (xdrx-geom-relation x y))
  186.                                        (progn (if (not (or (member (list x y) #ents_pair)
  187.                                                            (member (list y x) #ents_pair)
  188.                                                        )
  189.                                                   )
  190.                                                 (setq #ents_pair (cons (list x y) #ents_pair))
  191.                                               )
  192.                                               (setq cenx (list x y)
  193.                                                     cen1 (xdrx_getpropertyvalue x "centroid")
  194.                                                     cen2 (xdrx_getpropertyvalue y "centroid")
  195.                                               )
  196.                                               (if (not (assoc y #ents))
  197.                                                 (progn (xdrx_polyline_make cen1 cen2)
  198.                                                        (setq #ents (cons cenx #ents))
  199.                                                        (xdrx_setpropertyvalue (entlast)
  200.                                                                               "constantwidth"
  201.                                                                               #xd_var_global_topo_mark_height
  202.                                                                               "layer"
  203.                                                                               (xdrx-string-multilanguage "&#25299;&#25169;&#26680;&#26597;"
  204.                                                                                                          "Topology Verification"
  205.                                                                               )
  206.                                                                               "color"
  207.                                                                               4
  208.                                                        )
  209.                                                        (setq #fengxis (cons (entlast) #fengxis))
  210.                                                        (setq nums (1+ nums))
  211.                                                 )
  212.                                               )
  213.                                        )
  214.                                      )
  215.                                    )
  216.                                   ents1
  217.                           )
  218.                    )
  219.                  )
  220.                )
  221.               ents
  222.       )
  223.       (xd::odcl:progress-end)
  224.       (xdrx_prompt
  225.         (xdrx-string-formatex (xdrx-string-multilanguage "\n&#25628;&#32034;&#21040;&#31526;&#21512;&#26465;&#20214;&#30340;&#22810;&#36793;&#24418; %d &#32452;."
  226.                                                          "\nPolygon %d groups matching the criteria were found."
  227.                               )
  228.                               nums
  229.         )
  230.       )
  231.       (if (> nums 0)
  232.         (progn (setq tf t
  233.                      #i 0
  234.                )
  235.                (setq #mem-text (xdrx-mtext-make))
  236.                (setq cir1 (xdrx-circle-make)
  237.                      cir2 (xdrx-circle-make)
  238.                )
  239.                (xdrx-pointmonitor "_callback")
  240.                (while (and tf
  241.                            (xdrx_initget "S")
  242.                            (setq pt (getpoint
  243.                                       (xdrx-string-multilanguage "\n&#32553;&#25918;&#23631;&#24149;&#26597;&#30475;[&#26597;&#30475;&#19979;&#19968;&#20010;(S)]<&#36864;&#20986;>:"
  244.                                                                  "\nZoom screen to view [View next(S)]<Exit>:"
  245.                                       )
  246.                                     )
  247.                            )
  248.                       )
  249.                  (progn
  250.                    (cond ((= pt "S")
  251.                           (if (setq e (nth #i #fengxis))
  252.                             (progn (setq epoly (nth #i #ents_pair))
  253.                                    (setq #i  (1+ #i)
  254.                                          box (xdrx_entity_box e)
  255.                                          cen (xdrx_midp (car box) (caddr box))
  256.                                          h   (distance (car box) (last box))
  257.                                          w   (distance (car box) (cadr box))
  258.                                          h   (max h w)
  259.                                    )
  260.                                    (xdrx_document_zoomcenter cen (* 2.5 h))
  261.                                    (xdrx_document_setDwgViewfocus)
  262.                             )
  263.                             (progn (xdrx_prompt
  264.                                      (xdrx-string-multilanguage "\n>>&#24050;&#32463;&#26597;&#30475;&#23436;&#25152;&#26377;&#37325;&#21472;&#22810;&#36793;&#24418;."
  265.                                                                 "\n>>All overlapping polygons have been viewed."
  266.                                      )
  267.                                    )
  268.                                    (setq #i 0
  269.                                          epoly nil
  270.                                          e nil
  271.                                    )
  272.                                    (setq box (xdrx_entity_box #fengxis)
  273.                                          cen (xdrx_midp (car box) (caddr box))
  274.                                          h   (distance (car box) (last box))
  275.                                          w   (distance (car box) (cadr box))
  276.                                          h   (max h w)
  277.                                    )
  278.                                    (xdrx_document_zoomcenter cen (* 2 h))
  279.                             )
  280.                           )
  281.                          )
  282.                          (t (setq tf nil))
  283.                    )
  284.                  )
  285.                )
  286.                (xdrx-pointmonitor)
  287.                (xdrx_initget)
  288.         )
  289.       )
  290.     )
  291.   )
  292.   (redraw)
  293.   (setq *error* olderr)
  294.   (xdrx_end)
  295.   (princ)
  296. )

edit Kerry: [ code=cadlisp-7 ]
« Last Edit: January 19, 2024, 06:37:08 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