topic Re: Find and Mark Gaps-Lisp Repair in Visual LISP, AutoLISP and General Customization Forum

Find and Mark Gaps-Lisp Repair

Anonymous — Thu, 03 Dec 2015 18:19:51 GMT

I'm looking for a lisp that determines if lines/curves/polylines start end end on other lines. Most my drawings should never have a gap, all lines should start at the end of, or on another line/arc/polyline. I found a lisp that does this, but its old (1998) and no longer appears to be working right. The lisp flows fine but its giving me false positives. I was hoping someone could look at the code and repair it or point me to a current lisp that does this.

http://autocadtips1.com/2011/10/28/autolisp-find-and-mark-gaps/

" If you suspect that someone has been drafting and not using osnaps to snap to the endpoints of geometry, this routine will find these gaps and mark them with a red circle. It will even make a layer called “GAP” and put these red circles on that layer for you."

;| GAP.LSP locates and marks the ends of arcs, lines, and plines that are close
but not exactly coincident. Gaps are marked by drawing circles on the GAP layer.
You can select part of a drawing to check or press ENTER to check the whole drawing.
These are the distances to control how the gaps are located
Gap Limit = Gaps less than this, but more than fluff are marked
Fluff = Gaps less than this are not marked
Circle Size = Size of circle to mark gaps with
Original routine by McNeel & Associates
-----------------------------------------------------------------------
-----------------------------------------------------------------------
Modified by J. Tippit, SPAUG President 12/29/98
E-mail: cadpres@spaug.org
Web Site: http://www.spaug.org
-----------------------------------------------------------------------
-----------------------------------------------------------------------
Revisions:
12/29/98 Added ability to change Gap Limit, Fluff, & Circle Size
Added CMDECHO, UNDO, OSMODE, & CURLAY
Added a counter for the number of cicles that are drawn
and other misc. prompts
Changed the Gap layer to be RED
-----------------------------------------------------------------------
|;
(defun dxf (x e) (cdr (assoc x e)))
; Removes entities other than line, pline, arc from a selection set
(defun checkss (ss / i)
(setq i (sslength ss))
(while (> i 0)
(setq i (1- i))
(setq ent (entget (ssname ss i)))
(or
(= "LINE" (dxf 0 ent))
(= "POLYLINE" (dxf 0 ent))
(= "ARC" (dxf 0 ent))
(ssdel (ssname ss i) ss)
)
)
(if (> (sslength ss) 0)
ss
)
)
; Returns the endpoints of lines, arcs and pines
(defun endsofent (ent / v e1 e2)
(cond
((= "LINE" (dxf 0 ent))
(list (dxf 10 ent) (dxf 11 ent))
)
((= "ARC" (dxf 0 ent))
(list
(polar (dxf 10 ent) (dxf 50 ent) (dxf 40 ent))
(polar (dxf 10 ent) (dxf 51 ent) (dxf 40 ent))
)
)
((= "POLYLINE" (dxf 0 ent))
(setq v (entget (entnext (dxf -1 ent))))
(setq e1 (dxf 10 v))
(while (/= "SEQEND" (dxf 0 v))
(setq e2 (dxf 10 v))
(setq v (entget (entnext (dxf -1 v))))
)
(list e1 e2)
)
)
)
; gets a selection set of all entities near a point
(defun ssat (pt dist)
(ssget "c"
(list (- (car pt) dist) (- (cadr pt) dist))
(list (+ (car pt) dist) (+ (cadr pt) dist))
)
)
; Looks through a selection set and finds ends near but not at ends
; of other entities
(defun markgaps (ss / i ends)
(setq i (sslength ss))
(while (> i 0)
(setq i (1- i))
(setq ent (entget (ssname ss i)))
(setq ends (endsofent ent))
(princ ".")
; (princ "\n")
; (princ (car ends))
; (princ " -- ")
; (princ (cadr ends))
(endsnear (car ends) gaplimit)
(endsnear (cadr ends) gaplimit)
)
)
(defun circle (pt r)
(command "circle" pt r)
(if (= CNT nil)
(setq CNT 1)
(setq CNT (1+ CNT))
)
)
; Finds the entities near a point and marks their ends if they
; are also near the point
(defun endsnear ( pt dist / ent ends)
(if (setq sse (ssat pt dist))
(progn
(setq j (sslength sse))
(while (> j 0)
(setq j (1- j))
(setq ent (entget (ssname sse j)))
(if
(setq ends (endsofent ent))
(progn
(setq d (distance (car ends) pt))
(if (< 0.0 d gaplimit)
(circle pt circlesize)
)
(setq d (distance (cadr ends) pt))
(if (< 0.0 d gaplimit)
(circle pt circlesize)
)
)
)
)
)
)
)
; Main control function
(defun c:GAP ( / ss )
(setvar "cmdecho" 0)
(command "._undo" "be")
(setq #OSMOD (getvar "osmode"))
(setvar "osmode" 0)
(setq #CURLA (getvar "clayer"))
(setq CNT nil)
(if (= gaplimit nil)
(or
(setq gaplimit (getdist "\nSet Gap Limit <1.0>: "))
(setq gaplimit 1.0)
)
(progn
(setq gaplimit2 gaplimit)
(or
(setq gaplimit (getdist (strcat "\nSet Gap Limit <" (rtos gaplimit 2 1) ">: ")))
(setq gaplimit gaplimit2)
)
)
)
(if (= fluff nil)
(or
(setq fluff (getdist "\nSet Fluff <0.0001>: "))
(setq fluff 0.0001)
)
(progn
(setq fluff2 fluff)
(or
(setq fluff (getdist (strcat "\nSet Fluff <" (rtos fluff 2 4) ">: ")))
(setq fluff fluff2)
)
)
)
(if (= circlesize nil)
(or
(setq circlesize (getdist "\nSet Circle Size <2.0>: "))
(setq circlesize 2.0)
)
(progn
(setq circlesize2 circlesize)
(or
(setq circlesize (getdist (strcat "\nSet Circle Size <" (rtos circlesize 2 1) ">: ")))
(setq circlesize circlesize2)
)
)
)
(command "._layer" "m" "GAP" "c" "1" "GAP" "")
(princ "\nSelect objects or <ENTER> for all: ")
(or
(and
(setq ss (ssget))
(setq ss (checkss ss))
)
(setq ss (ssget "x"
'((-4 . "<OR")
(0 . "LINE")
(0 . "ARC")
(0 . "POLYLINE")
(-4 . "OR>")
)
)
)
)
(princ "\nChecking for Gaps - please wait")
(markgaps ss)
(princ "done!")
(if (/= CNT nil)
(princ (strcat "\n" (itoa CNT) " Circles drawn."))
(princ "\nNo Gaps found.")
)
(setvar "clayer" #CURLA)
(setvar "osmode" #OSMOD)
(command "._undo" "e")
(setvar "cmdecho" 1)
(princ)
)
(prompt "\nLOCATE GAPS is loaded... type GAP to start!")
(princ)

Here is a file that I have been testing it on. White lines it gives the correct gaps, but for green lines its giving me false positives.

Re: Find and Mark Gaps-Lisp Repair

АлексЮстасу — Fri, 04 Dec 2015 17:54:42 GMT

Yes, it would be good to revive this lisp.

Re: Find and Mark Gaps-Lisp Repair

Anonymous — Fri, 04 Dec 2015 18:52:50 GMT

My version

;| GAP.LSP locates and marks the ends of arcs, lines, and plines that are close
but not exactly coincident. Gaps are marked by drawing circles on the GAP layer.
You can select part of a drawing to check or press ENTER to check the whole drawing.
These are the distances to control how the gaps are located
Gap Limit = Gaps less than this, but more than fluff are marked
Fluff = Gaps less than this are not marked
Circle Size = Size of circle to mark gaps with
Original routine by McNeel & Associates
-----------------------------------------------------------------------
-----------------------------------------------------------------------
Modified by J. Tippit, SPAUG President 12/29/98
E-mail: cadpres@spaug.org
Web Site: http://www.spaug.org
-----------------------------------------------------------------------
-----------------------------------------------------------------------
Revisions:
12/29/98 Added ability to change Gap Limit, Fluff, & Circle Size
Added CMDECHO, UNDO, OSMODE, & CURLAY
Added a counter for the number of cicles that are drawn
and other misc. prompts
Changed the Gap layer to be RED

12/04/2015 VVA for dwg.ru
Web site: http://autocadtips1.com/2011/10/28/autolisp-find-and-mark-gaps/
posted http://forum.dwg.ru/showthread.php?p=1479981#post1479981
-----------------------------------------------------------------------
|;
(defun dxf (x e) (cdr (assoc x e)))
; Removes entities other than line, pline, arc from a selection set
(defun checkss (ss / i)
(setq i (sslength ss))
(while (> i 0)
(setq i (1- i))
(setq ent (entget (ssname ss i)))
(or
(= "LINE" (dxf 0 ent))
(= "POLYLINE" (dxf 0 ent))
(= "LWPOLYLINE" (dxf 0 ent))
(= "ARC" (dxf 0 ent))
(ssdel (ssname ss i) ss)
)
)
(if (> (sslength ss) 0)
ss
)
)
; Returns the endpoints of lines, arcs and pines
(defun endsofent (ent / v e1 e2)
(cond
((= "LINE" (dxf 0 ent))
(list (dxf 10 ent) (dxf 11 ent))
)
((= "ARC" (dxf 0 ent))
(list
(polar (dxf 10 ent) (dxf 50 ent) (dxf 40 ent))
(polar (dxf 10 ent) (dxf 51 ent) (dxf 40 ent))
)
)
((= "POLYLINE" (dxf 0 ent))
(setq v (entget (entnext (dxf -1 ent))))
(setq e1 (dxf 10 v))
(while (/= "SEQEND" (dxf 0 v))
(setq e2 (dxf 10 v))
(setq v (entget (entnext (dxf -1 v))))
)
(list e1 e2)
)
((= "LWPOLYLINE" (dxf 0 ent))
(setq e1 (dxf 10 ent))
(setq e2 (dxf 10 (reverse ent)))
(list e1 e2)
)
)
)
; gets a selection set of all entities near a point
(defun ssat (pt dist)
(ssget "_c"
(list (- (car pt) dist) (- (cadr pt) dist))
(list (+ (car pt) dist) (+ (cadr pt) dist))
)
)
; Looks through a selection set and finds ends near but not at ends
; of other entities
(defun markgaps (ss / i ends)
(setq i (sslength ss))
(while (> i 0)
(setq i (1- i))
(setq ent (entget (ssname ss i)))
(setq ends (endsofent ent))
(princ ".")
; (princ "\n")
; (princ (car ends))
; (princ " -- ")
; (princ (cadr ends))
(endsnear (car ends) gaplimit)
(endsnear (cadr ends) gaplimit)
)
)
(defun circle (pt r)
(command "_circle" pt r)
(if (= CNT nil)
(setq CNT 1)
(setq CNT (1+ CNT))
)
)
; Finds the entities near a point and marks their ends if they
; are also near the point
(defun endsnear ( pt dist / ent ends)
(if (setq sse (ssat pt dist))
(progn
(setq j (sslength sse))
(while (> j 0)
(setq j (1- j))
(setq ent (entget (ssname sse j)))
(if
(setq ends (endsofent ent))
(progn
(setq d (distance (car ends) pt))
(if (< 0.0 d gaplimit)
(circle pt circlesize)
)
(setq d (distance (cadr ends) pt))
(if (< 0.0 d gaplimit)
(circle pt circlesize)
)
)
)
)
)
)
)
; Main control function
(defun c:GAP ( / ss )
(setvar "cmdecho" 0)
(command "_.undo" "_begin")
(setq #OSMOD (getvar "osmode"))
(setvar "osmode" 0)
(setq #CURLA (getvar "clayer"))
(setq CNT nil)
(if (= gaplimit nil)
(or
(setq gaplimit (getdist "\nSet Gap Limit <1.0>: "))
(setq gaplimit 1.0)
)
(progn
(setq gaplimit2 gaplimit)
(or
(setq gaplimit (getdist (strcat "\nSet Gap Limit <" (rtos gaplimit 2 1) ">: ")))
(setq gaplimit gaplimit2)
)
)
)
(if (= fluff nil)
(or
(setq fluff (getdist "\nSet Fluff <0.0001>: "))
(setq fluff 0.0001)
)
(progn
(setq fluff2 fluff)
(or
(setq fluff (getdist (strcat "\nSet Fluff <" (rtos fluff 2 4) ">: ")))
(setq fluff fluff2)
)
)
)
(if (= circlesize nil)
(or
(setq circlesize (getdist "\nSet Circle Size <2.0>: "))
(setq circlesize 2.0)
)
(progn
(setq circlesize2 circlesize)
(or
(setq circlesize (getdist (strcat "\nSet Circle Size <" (rtos circlesize 2 1) ">: ")))
(setq circlesize circlesize2)
)
)
)
(command "_.layer" "_m" "GAP" "_c" "1" "GAP" "")
(princ "\nSelect objects or <ENTER> for all: ")
(or
(and
(setq ss (ssget))
(setq ss (checkss ss))
)
(setq ss (ssget "_x"
'((-4 . "<OR")
(0 . "LINE")
(0 . "ARC")
(0 . "POLYLINE")
(-4 . "OR>")
)
)
)
)
(princ "\nChecking for Gaps - please wait")
(markgaps ss)
(princ "done!")
(if (/= CNT nil)
(princ (strcat "\n" (itoa CNT) " Circles drawn."))
(princ "\nNo Gaps found.")
)
(setvar "clayer" #CURLA)
(setvar "osmode" #OSMOD)
(command "_.undo" "_e")
(setvar "cmdecho" 1)
(princ)
)
(prompt "\nLOCATE GAPS is loaded... type GAP to start!")
(princ)

Re: Find and Mark Gaps-Lisp Repair

Kent1Cooper — Fri, 04 Dec 2015 20:55:08 GMT

I have a thought -- I'm wondering about floating-point-decimal precision issues, which can sometimes cause issues such as this.

This part in the (endsnear) function could be the culprit:

(setq d (distance (car ends) pt))
(if (< 0.0 d gaplimit)
(circle pt circlesize)
)

Because of the way the routine gets object endpoints, with calculations using pieces extracted from entity data lists, it could be that even if an object's end does lie exactly on some other object, the result of those accumulated calculations, compounded by being used in a (distance) function, could come out to, for example, 0.0000000000038104, rather than exactly 0.0. The (<) function can tell the difference, so it will not consider that endpoint to fall precisely on the other object, and therefore will mark it.

Since the result of a (distance) function is never negative, you could have it check whether it's not-right-on within some tight tolerance, rather than whether the calculated distance is greater than 0. The (equal) function has a fuzz-factor option. Try [I haven't gone through the exercise] something like this, instead of the (if) function above, so that if it's right on to within 10-to-the-minus-8 [change that number to whatever precision you need], even if the calculated distance isn't precisely zero, it won't mark it:

(if

(and

(not (equal d 0.0 1e-8))

(< d gaplimit)

); and

(circle pt circlesize)
); if

Re: Find and Mark Gaps-Lisp Repair

Anonymous — Fri, 04 Dec 2015 23:03:39 GMT

v.azarko - Still gives me the same false positives that I was getting before.

Kent - Your talking above my head, but from what little I understand that sounds legiitamte. No idea where to add your line of code. I know many off the false positives I get our two lines that look like they are connected, read the same start and end points, and I can join into a poyline. So some kind of mathmatical error on how it determines if two end point are the same makes sense to me.

Re: Find and Mark Gaps-Lisp Repair

Kent1Cooper — Sat, 05 Dec 2015 03:08:34 GMT

@Anonymous wrote:

.... No idea where to add your line of code. ....

To pull the instructions in Post 4 out of the surrounding clutter:

....

(if (< 0.0 d gaplimit)
(circle pt circlesize)
)

.... Try ... this, instead of the (if) function above... :

(if

(and

(not (equal d 0.0 1e-8))

(< d gaplimit)

); and

(circle pt circlesize)
); if

Re: Find and Mark Gaps-Lisp Repair

АлексЮстасу — Sat, 05 Dec 2015 18:57:02 GMT

In my 2016 for GAP-Test.dwg of the first message:

- 123 circles-markers,

- 2 true gaps,

- 1 gap - debatable,

- other - false. 8 - line, arc < limit. For all other I do not find explanations.

All parameters by default, diameter of circles - 0.4.

Re: Find and Mark Gaps-Lisp Repair

hmsilva — Sat, 05 Dec 2015 22:17:34 GMT

Hi Chris,

try this quick and dirty 'demo'

(vl-load-com)
(defun c:demo (/ get_glob_real mk_circle hnd i lst obj ori pt ss ss1 ss2)

   (defun get_glob_real (var msg mod prec def / tmpH)
      (if (or (not var) (/= (type var) 'REAL))
         (setq var def)
      )
      (initget 6)
      (setq tmpH (getreal (strcat "\n" msg " <" (rtos var mod prec) ">: ")))
      (if (/= tmpH nil)
         (setq var tmpH)
      )
      var
   )

   (defun mk_circle (pt dia)
      (entmake
         (list
            '(0 . "CIRCLE")
            '(8 . "GAP")
            (cons 10 pt)
            (cons 40 (/ dia 2.0))
            '(62 . 1)
         )
      )
   )

   (if (and (setq *_max_fuzz (get_glob_real *_max_fuzz "Enter Maximum Gap" 2 3 0.05))
            (setq *_min_fuzz (get_glob_real *_min_fuzz "Enter Minimum Gap" 2 3 0.001))
            (setq *_dia (get_glob_real *_dia "Enter Circle Size" 2 2 0.50))
            (setq ss (ssget '((0 . "ARC,LINE,LWPOLYLINE"))))
       )
      (progn

         (repeat (setq i (sslength ss))
            (setq hnd (ssname ss (setq i (1- i)))
                  lst (cons (vlax-curve-getstartpoint hnd) lst)
                  lst (cons (vlax-curve-getendpoint hnd) lst)
            )
         )
         (while lst
            (setq pt  (car lst)
                  lst (cdr lst)
            )
            (if (not (vl-some '(lambda (p) (equal p pt *_min_fuzz)) lst))
               (if (setq ss1 (ssget "_C"
                                    (list (- (car pt) *_max_fuzz) (- (cadr pt) *_max_fuzz))
                                    (list (+ (car pt) *_max_fuzz) (+ (cadr pt) *_max_fuzz))
                             )
                   )
                  (if (setq ss2 (ssget "_C" pt pt '((0 . "ARC,LINE,LWPOLYLINE"))))
                     (progn
                        (setq ori (ssname ss2 0))
                        (repeat (setq i (sslength ss2))
                           (setq hnd (ssname ss2 (setq i (1- i)))
                                 obj (vlax-ename->vla-object hnd)
                           )
                           (if (and (not (eq ori hnd))
                                    (not (vlax-curve-getParamAtPoint obj pt))
                               )
                              (mk_circle pt *_dia)
                           )
                        )
                     )
                  )
               )
            )
            (setq lst (vl-remove-if '(lambda (p) (equal p pt *_min_fuzz)) lst))
         )
      )
   )
   (princ)
)

Hope this helps,
Henrique

Re: Find and Mark Gaps-Lisp Repair

АлексЮстасу — Sun, 06 Dec 2015 02:15:38 GMT

For GAP-Test.dwg became excellent.
I did GAP-Test_polyline.dwg with polylines.

Results for some reason depend on the zoom. What less zoom, the anymore finds breaks.
At a maximal zoom can find nothing.
A right upper case finds never.

On my opinion, the search of gaps is needed in units of drawing.

Re: Find and Mark Gaps-Lisp Repair

hmsilva — Sun, 06 Dec 2015 15:56:01 GMT

@АлексЮстасу wrote:

For GAP-Test.dwg became excellent.
I did GAP-Test_polyline.dwg with polylines.

Results for some reason depend on the zoom. What less zoom, the anymore finds breaks.
At a maximal zoom can find nothing.
A right upper case finds never.

On my opinion, the search of gaps is needed in units of drawing.

Hi Alexander,

try this quickly revised 'demo'

(vl-load-com)
(defun c:demo (/ get_glob_real mk_circle hnd i lst obj ori pt pt1 pt2 ss ss1 ss2)

   (defun get_glob_real (var msg mod prec def / tmpH)
      (if (or (not var) (/= (type var) 'REAL))
         (setq var def)
      )
      (initget 6)
      (setq tmpH (getreal (strcat "\n" msg " <" (rtos var mod prec) ">: ")))
      (if (/= tmpH nil)
         (setq var tmpH)
      )
      var
   )

   (defun mk_circle (pt dia)
      (entmake
         (list
            '(0 . "CIRCLE")
            '(8 . "GAP")
            (cons 10 pt)
            (cons 40 (/ dia 2.0))
            '(62 . 1)
         )
      )
   )

   (if (and (setq *_max_fuzz (get_glob_real *_max_fuzz "Enter Maximum Gap" 2 3 0.05))
            (setq *_min_fuzz (get_glob_real *_min_fuzz "Enter Minimum Gap" 2 3 0.001))
            (setq *_dia (get_glob_real *_dia "Enter Circle Size" 2 2 0.50))
            (setq ss (ssget '((0 . "ARC,LINE,LWPOLYLINE"))))
       )
      (progn
         (vl-cmdf "_.-view" "_S" "temp_h" "_.ucs" "_W")
         (repeat (setq i (sslength ss))
            (setq hnd (ssname ss (setq i (1- i)))
                  lst (cons (vlax-curve-getstartpoint hnd) lst)
                  lst (cons (vlax-curve-getendpoint hnd) lst)
            )
         )
         (while lst
            (setq pt  (car lst)
                  lst (cdr lst)
            )
            (if (not (vl-some '(lambda (p) (equal p pt *_min_fuzz)) lst))
               (if (and (vl-cmdf "_.zoom"
                                 (setq pt1 (list (- (car pt) *_max_fuzz) (- (cadr pt) *_max_fuzz)))
                                 (setq pt2 (list (+ (car pt) *_max_fuzz) (+ (cadr pt) *_max_fuzz)))
                        )
                        (setq ss1 (ssget "_C" pt1 pt2))
                   )
                  (if (setq ss2 (ssget "_C" pt pt '((0 . "ARC,LINE,LWPOLYLINE"))))
                     (progn
                        (setq ori (ssname ss2 0))
                        (repeat (setq i (sslength ss1))
                           (setq hnd (ssname ss1 (setq i (1- i)))
                                 obj (vlax-ename->vla-object hnd)
                           )
                           (if (ssmemb hnd ss)
                              (if (and (not (eq ori hnd))
                                       (not (vlax-curve-getParamAtPoint obj pt))
                                  )
                                 (mk_circle pt *_dia)
                                 (if (and (eq ori hnd)
                                          (= (vla-get-objectname obj) "AcDbPolyline")
                                          (= (vla-get-closed obj) :vlax-false)
                                          (<= *_min_fuzz (distance (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj)) *_max_fuzz)
                                     )
                                    (mk_circle pt *_dia)
                                 )
                              )
                           )
                        )
                     )
                  )
               )
            )
            (setq lst (vl-remove-if '(lambda (p) (equal p pt *_min_fuzz)) lst))
         )
         (vl-cmdf "_.-view" "_R" "temp_h" "_.-view" "_D" "temp_h")
      )
   )
   (princ)
)

Hope this helps,
Henrique

Re: Find and Mark Gaps-Lisp Repair

АлексЮстасу — Mon, 07 Dec 2015 10:21:52 GMT

Hi, Henrique,

thank you, now better find gaps.

Tried to add to the lines

(setq ss (ssget '((0 . "ARC,LINE,LWPOLYLINE"))))

(if (setq ss2 (ssget "_C" pt pt '((0 . "ARC,LINE,LWPOLYLINE"))))

"3DPOLYLINE, SPLINE". To my large surprise the program began to process SPLINE.
But 3DPOLYLINE did not begin to process. I know that my actions are funny - I do not quite know lisp.

Now the program works notedly slower. It from the actions of .-view, _.ucs, .zoom?

Re: Find and Mark Gaps-Lisp Repair

Anonymous — Mon, 07 Dec 2015 12:25:40 GMT

Try it

(setq ss (ssget '((0 . "ARC,*LINE"))))
 
(if (setq ss2 (ssget "_C" pt pt '((0 . "ARC,*LINE"))))

Re: Find and Mark Gaps-Lisp Repair

Anonymous — Mon, 07 Dec 2015 13:01:53 GMT

Next version

;| GAP.LSP locates and marks the ends of arcs, lines, and plines that are close
but not exactly coincident. Gaps are marked by drawing circles on the GAP layer.
You can select part of a drawing to check or press ENTER to check the whole drawing.
These are the distances to control how the gaps are located
Gap Limit = Gaps less than this, but more than fluff are marked
Fluff = Gaps less than this are not marked
Circle Size = Size of circle to mark gaps with
Original routine by McNeel & Associates
-----------------------------------------------------------------------
-----------------------------------------------------------------------
Modified by J. Tippit, SPAUG President 12/29/98
E-mail: cadpres@spaug.org
Web Site: http://www.spaug.org
-----------------------------------------------------------------------
-----------------------------------------------------------------------
Revisions:
12/29/98 Added ability to change Gap Limit, Fluff, & Circle Size
Added CMDECHO, UNDO, OSMODE, & CURLAY
Added a counter for the number of cicles that are drawn
and other misc. prompts
Changed the Gap layer to be RED

12/04/2015 VVA for dwg.ru
Web site: http://autocadtips1.com/2011/10/28/autolisp-find-and-mark-gaps/
posted http://forum.dwg.ru/showthread.php?p=1479981#post1479981
-----------------------------------------------------------------------
|;
(vl-load-com)
(defun dxf (x e) (cdr (assoc x e)))
 ;_ Removes entities other than line, pline, arc from a selection set
(defun checkss (ss / i)
 (setq i (sslength ss))
 (while (> i 0)
 (setq i (1- i))
 (setq ent (entget (ssname ss i)))
 (or
 (= "LINE" (dxf 0 ent))
 (= "POLYLINE" (dxf 0 ent))
 (= "LWPOLYLINE" (dxf 0 ent))
 (= "SPLINE" (dxf 0 ent))
 (= "ARC" (dxf 0 ent))
 (ssdel (ssname ss i) ss)
 ) ;_ end of or
 ) ;_ end of while
 (if (> (sslength ss) 0)
 ss
 ) ;_ end of if
) ;_ end of defun
 ;_ Returns the endpoints of lines, arcs and pines
(defun endsofent (ent / v e1 e2)
 (cond
 ((= "LINE" (dxf 0 ent))
 (list (dxf 10 ent) (dxf 11 ent))
 )
 ((= "ARC" (dxf 0 ent))
 (list
 (polar (dxf 10 ent) (dxf 50 ent) (dxf 40 ent))
 (polar (dxf 10 ent) (dxf 51 ent) (dxf 40 ent))
 ) ;_ end of list
 )
 ((= "POLYLINE" (dxf 0 ent))
 (setq v (entget (entnext (dxf -1 ent))))
 (setq e1 (dxf 10 v))
 (while (/= "SEQEND" (dxf 0 v))
 (setq e2 (dxf 10 v))
 (setq v (entget (entnext (dxf -1 v))))
 ) ;_ end of while
 (list e1 e2)
 )
 ((= "LWPOLYLINE" (dxf 0 ent))
 (setq e1 (dxf 10 ent))
 (setq e2 (dxf 10 (reverse ent)))
 (list e1 e2)
 )
 ((= "SPLINE" (dxf 0 ent))
 (list
 (vlax-curve-getstartpoint
 (vlax-ename->vla-object (dxf -1 ent))
 ) ;_ end of vlax-curve-getStartPoint
 (vlax-curve-getendpoint
 (vlax-ename->vla-object (dxf -1 ent))
 ) ;_ end of vlax-curve-getEndPoint
 ) ;_ end of list
 )
 ) ;_ end of cond
) ;_ end of defun
 ;_ gets a selection set of all entities near a point
(defun ssat (pt dist)
 (ssget "_c"
 (list (- (car pt) dist) (- (cadr pt) dist))
 (list (+ (car pt) dist) (+ (cadr pt) dist))
 ) ;_ end of ssget
) ;_ end of defun
 ;_ Looks through a selection set and finds ends near but not at ends
 ;_ of other entities
(defun markgaps (ss / i ends)
 (setq i (sslength ss))
 (while (> i 0)
 (setq i (1- i))
 (setq ent (entget (ssname ss i)))
 (setq ends (endsofent ent))
 (princ ".")
 ;_ (princ "\n")
 ;_ (princ (car ends))
 ;_ (princ " -- ")
 ;_ (princ (cadr ends))
 (endsnear (car ends) gaplimit)
 (endsnear (cadr ends) gaplimit)
 ) ;_ end of while
) ;_ end of defun
(defun circle (pt r)
 (command "_circle" "_none" pt r)
 (if (= CNT nil)
 (setq CNT 1)
 (setq CNT (1+ CNT))
 ) ;_ end of if
) ;_ end of defun
 ;_ Finds the entities near a point and marks their ends if they
 ;_ are also near the point
(defun endsnear (pt dist / ent ends)
 (if (setq sse (ssat pt dist))
 (progn
 (setq j (sslength sse))
 (while (> j 0)
 (setq j (1- j))
 (setq ent (entget (ssname sse j)))
 (if
 (setq ends (endsofent ent))
 (progn
 (setq d (distance (car ends) pt))

 (if
 (and
 (not (equal d 0.0 1e-8))
 (< d gaplimit)
 ) ;_ and
 (circle pt circlesize)
 ) ;_ if

 (setq d (distance (cadr ends) pt))
 ) ;_ end of progn
 ) ;_ end of if
 ) ;_ end of while
 ) ;_ end of progn
 ) ;_ end of if
) ;_ end of defun
 ;_ Main control function
(defun c:GAP (/ ss)
 (setvar "cmdecho" 0)
 (command "_.undo" "_begin")
 (setq #OSMOD (getvar "osmode"))
 (setvar "osmode" 0)
 (setq #CURLA (getvar "clayer"))
 (setq CNT nil)
 (if (= gaplimit nil)
 (or
 (setq gaplimit (getdist "\nSet Gap Limit <1.0>: "))
 (setq gaplimit 1.0)
 ) ;_ end of or
 (progn
 (setq gaplimit2 gaplimit)
 (or
 (setq gaplimit (getdist (strcat "\nSet Gap Limit <"
 (rtos gaplimit 2 1)
 ">: "
 ) ;_ end of strcat
 ) ;_ end of getdist
 ) ;_ end of setq
 (setq gaplimit gaplimit2)
 ) ;_ end of or
 ) ;_ end of progn
 ) ;_ end of if
 (if (= fluff nil)
 (or
 (setq fluff (getdist "\nSet Fluff <0.0001>: "))
 (setq fluff 0.0001)
 ) ;_ end of or
 (progn
 (setq fluff2 fluff)
 (or
 (setq fluff
 (getdist (strcat "\nSet Fluff <" (rtos fluff 2 4) ">: ")
 ) ;_ end of getdist
 ) ;_ end of setq
 (setq fluff fluff2)
 ) ;_ end of or
 ) ;_ end of progn
 ) ;_ end of if
 (if (= circlesize nil)
 (or
 (setq circlesize (getdist "\nSet Circle Size <2.0>: "))
 (setq circlesize 2.0)
 ) ;_ end of or
 (progn
 (setq circlesize2 circlesize)
 (or
 (setq circlesize
 (getdist (strcat "\nSet Circle Size <"
 (rtos circlesize 2 1)
 ">: "
 ) ;_ end of strcat
 ) ;_ end of getdist
 ) ;_ end of setq
 (setq circlesize circlesize2)
 ) ;_ end of or
 ) ;_ end of progn
 ) ;_ end of if
 (command "_.layer" "_m" "GAP" "_c" "1" "GAP" "")
 ;_ (princ "\nSelect objects or <ENTER> for all: ")
 (or
 (and
 (setq ss (ssget "_I"))
 (setq ss (checkss ss))
 ) ;_ end of and
 (progn
 (SSSETFIRST nil nil)
 (setq ss (ssget 
 '((-4 . "<OR")
 (0 . "LINE")
 (0 . "ARC")
 (0 . "POLYLINE")
 (0 . "LWPOLYLINE")
 (0 . "SPLINE")
 (-4 . "OR>")
 )
 ) ;_ end of ssget
 ) ;_ end of setq
 )
 ) ;_ end of or
 (princ "\nChecking for Gaps - please wait")
 (if (and ss (eq (type ss) 'PICKSET) (> (sslength ss) 0))
 (markgaps ss)
 ) ;_ end of if
 (princ "done!")
 (if (/= CNT nil)
 (princ (strcat "\n" (itoa CNT) " Circles drawn."))
 (princ "\nNo Gaps found.")
 ) ;_ end of if
 (setvar "clayer" #CURLA)
 (setvar "osmode" #OSMOD)
 (command "_.undo" "_e")
 (setvar "cmdecho" 1)
 (princ)
) ;_ end of defun
(prompt "\nLOCATE GAPS is loaded... type GAP to start!")
(princ)

Tested on GAP-Test_2.dwg with next settings

Command: gap
Set Gap Limit <0.1>:
Set Fluff <0.0001>:
Set Circle Size <2.0>:

Re: Find and Mark Gaps-Lisp Repair

Anonymous — Mon, 07 Dec 2015 13:02:43 GMT

Edit previous post

Re: Find and Mark Gaps-Lisp Repair

hmsilva — Mon, 07 Dec 2015 14:40:03 GMT

@АлексЮстасу wrote:

Hi, Henrique,

thank you, now better find gaps.

Tried to add to the lines

(setq ss (ssget '((0 . "ARC,LINE,LWPOLYLINE"))))

(if (setq ss2 (ssget "_C" pt pt '((0 . "ARC,LINE,LWPOLYLINE"))))

"3DPOLYLINE, SPLINE". To my large surprise the program began to process SPLINE.
But 3DPOLYLINE did not begin to process. I know that my actions are funny - I do not quite know lisp.
...

@Anonymous wrote:

Try it

(setq ss (ssget '((0 . "ARC,*LINE"))))
 
(if (setq ss2 (ssget "_C" pt pt '((0 . "ARC,*LINE"))))

Hi Alexander,

please be aware using the ssget filter suggested by v.azarko, we'll select MLINE, XLINE... too.

I would suggest something like this, to select polylines, lines arcs and splines

(setq ss (ssget '((0 . "ARC,*POLYLINE,LINE,SPLINE"))))
 
(if (setq ss2 (ssget "_C" pt pt '((0 . "ARC,*POLYLINE,LINE,SPLINE"))))

@АлексЮстасу wrote:

...
Now the program works notedly slower. It from the actions of .-view, _.ucs, .zoom?

Yes, the 'demo' will run slower, because will have to zoom to each selection zone to ensure that the objects are visible and will be selected...

Hope this helps,
Henrique

Re: Find and Mark Gaps-Lisp Repair

Anonymous — Mon, 07 Dec 2015 20:13:54 GMT

This Code works a lot better. still getting false positives on the I-beam. I ran it on a larger data set and got some more false positives. added it to Grid-Test_V2. Thanks for all the help.

Re: Find and Mark Gaps-Lisp Repair

АлексЮстасу — Tue, 08 Dec 2015 03:57:42 GMT

Hi, Henrique, thank you!

Мery little has false gaps applied the test file. (limit 1.0).

For me four questions are in general:

1. How to do the search of Gaps taking into account Z, heights?
2. How to do the use of pre-selection?
3. How to do Enter instead of choice of objects - for the select all? (To leave the select objects, if there is not pre-selection)
3. And, do I confess, I do not understand why is Fluff needed? 🙂

But most important - at the use in the program of zoom, etc. treatment of the real files will be too long. And undo too long.

Re: Find and Mark Gaps-Lisp Repair

АлексЮстасу — Tue, 08 Dec 2015 04:11:39 GMT

Also false gap - not always correctly taken into account the value of the limit:
- GAP-Test_polyline_spline-more_limit10.png - for 1.0,
- GAP-Test_polyline_spline-more_limit05.png - for 0.5.

Re: Find and Mark Gaps-Lisp Repair

hmsilva — Tue, 08 Dec 2015 11:52:19 GMT

@АлексЮстасу wrote:

Hi, Henrique, thank you!

Мery little has false gaps applied the test file. (limit 1.0).

For me four questions are in general:

1. How to do the search of Gaps taking into account Z, heights?
2. How to do the use of pre-selection?
3. How to do Enter instead of choice of objects - for the select all? (To leave the select objects, if there is not pre-selection)
3. And, do I confess, I do not understand why is Fluff needed? 🙂

But most important - at the use in the program of zoom, etc. treatment of the real files will be too long. And undo too long.

Hi Alexander, you're welcome!

1. How to do the search of Gaps taking into account Z, heights?

Do you mean to ignore the Z's?

The code test for distance, so it will test all Z's...

2 and 3 quickly revised in 'demo'...

I dont use the word 'Fluff' in my 'demo', I use the 'Maximum/Minimum Gap', and we have to set in code the maximum distance to scan objects, otherwise all objects would be marked with a circle.

But most important - at the use in the program of zoom, etc. treatment of the real files will be too long. And undo too long.

Alexander, my code is just a 'demo', It is not a finished program, nor is it my intention.

To rewrite the code without using 'selections' it would be necessary to have free time, and currently I'm in big workload...

(vl-load-com)
(defun c:demo (/ *error* get_glob_real mk_circle hnd i lst obj ori pt pt1 pt2 ss ss1 ss2)

   (defun *error* (msg)
      (if command-s
         (progn (command-s "_.-view" "_R" "temp_h")
                (command-s "_.-view" "_D" "temp_h")
         )
         (vl-cmdf "_.-view" "_R" "temp_h" "_.-view" "_D" "temp_h")
      )
      (vla-endundomark acdoc)
      (cond ((not msg))
            ((member msg '("Function cancelled" "quit / exit abort")))
            ((princ (strcat "\n** Error: " msg " ** ")))
      )
      (princ)
   )

   (defun get_glob_real (var msg mod prec def / tmpH)
      (if (or (not var) (/= (type var) 'REAL))
         (setq var def)
      )
      (initget 6)
      (setq tmpH (getreal (strcat "\n" msg " <" (rtos var mod prec) ">: ")))
      (if (/= tmpH nil)
         (setq var tmpH)
      )
      var
   )

   (defun mk_circle (pt dia)
      (entmake
         (list
            '(0 . "CIRCLE")
            '(8 . "GAP")
            (cons 10 pt)
            (cons 40 (/ dia 2.0))
            '(62 . 1)
         )
      )
   )

   (or acdoc (setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
   (vla-startundomark acdoc)
   (vl-cmdf "_.-view" "_S" "temp_h" "_.ucs" "_W")
   (if (and (setq *_max_fuzz (get_glob_real *_max_fuzz "\n Enter Maximum Gap" 2 3 1.00))
            (setq *_min_fuzz (get_glob_real *_min_fuzz "\n Enter Minimum Gap" 2 3 0.001))
            (setq *_dia (get_glob_real *_dia "\n Enter Circle Size" 2 2 0.50))
            (princ "\n Select objects or <ENTER> for all: ")
            (or (setq ss (ssget '((0 . "ARC,LINE,*POLYLINE,SPLINE"))))
                (setq ss (ssget "_X" (list '(0 . "ARC,LINE,*POLYLINE,SPLINE") (cons 410 (getvar 'ctab)))))
            )
       )
      (progn
         (repeat (setq i (sslength ss))
            (setq hnd (ssname ss (setq i (1- i)))
                  lst (cons (vlax-curve-getstartpoint hnd) lst)
                  lst (cons (vlax-curve-getendpoint hnd) lst)
            )
         )
         (while lst
            (setq pt  (car lst)
                  lst (cdr lst)
            )
            (if (not (vl-some '(lambda (p) (equal p pt *_min_fuzz)) lst))
               (if (and (vl-cmdf "_.zoom"
                                 (setq pt1 (list (- (car pt) *_max_fuzz) (- (cadr pt) *_max_fuzz)))
                                 (setq pt2 (list (+ (car pt) *_max_fuzz) (+ (cadr pt) *_max_fuzz)))
                        )
                        (setq ss1 (ssget "_C" pt1 pt2))
                   )
                  (if (setq ss2 (ssget "_C" pt pt '((0 . "ARC,LINE,*POLYLINE,SPLINE"))))
                     (progn
                        (setq ori (ssname ss2 0))
                        (repeat (setq i (sslength ss1))
                           (setq hnd (ssname ss1 (setq i (1- i)))
                                 obj (vlax-ename->vla-object hnd)
                           )
                           (if (ssmemb hnd ss)
                              (if (and (not (eq ori hnd))
                                       (not (vlax-curve-getParamAtPoint obj pt))
                                       (< (distance pt (vlax-curve-getClosestPointTo obj pt)) *_max_fuzz)
                                  )
                                 (mk_circle pt *_dia)
                                 (if (and (eq ori hnd)
                                          (wcmatch (vla-get-objectname obj) "*Polyline,*Spline")
                                          (= (vla-get-closed obj) :vlax-false)
                                          (> (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) *_max_fuzz)
                                          (<= *_min_fuzz (distance (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj)) *_max_fuzz)
                                     )
                                    (mk_circle pt *_dia)
                                 )
                              )
                           )
                        )
                     )
                  )
               )
            )
            (setq lst (vl-remove-if '(lambda (p) (equal p pt *_min_fuzz)) lst))
         )
      )
   )
   (*error* nil)
   (princ)
)

Hope this helps,
Henrique

Re: Find and Mark Gaps-Lisp Repair

АлексЮстасу — Tue, 08 Dec 2015 15:18:02 GMT

Hi, Henrique,

Now Enter=all does not work

 Select objects or <ENTER> for all:
Select objects:
_.-view Enter an option [?/Delete/Orthographic/Restore/Save/sEttings/Window]: _R Enter view name to restore: temp_h
Command: _.-view Enter an option [?/Delete/Orthographic/Restore/Save/sEttings/Window]: _D
Enter view name(s) to delete: temp_h
Command:
** Error: bad argument value: AcDbCurve 112 **

@hmsilva wrote:
Do you mean to ignore the Z's?
The code test for distance, so it will test all Z's...
Yes, not to ignore Z, elevation etc. It is now made well.

@hmsilva wrote:
my code is just a 'demo', It is not a finished program, nor is it my intention.
Yes, it is clear. But the principle of dependence on zoom etc it is impossible to avoid?

Still there are markers, disputable for me, - on the ends of "polyline" from many pieces:
Also there is one unclear case at maximum Gap - 1.0, minimum Gap - 0.5: