Find and Mark Gaps-Lisp Repair

Find and Mark Gaps-Lisp Repair

Anonymous
Not applicable
14,848 Views
54 Replies
Message 1 of 55

Find and Mark Gaps-Lisp Repair

Anonymous
Not applicable

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. 

 

 

 

 

0 Likes
Accepted solutions (1)
14,849 Views
54 Replies
Replies (54)
Message 41 of 55

Anonymous
Not applicable

Henrique,

 

     Thansk for all your help, this code has been working great. The time savings of running versus looking for mistakes myself is hours. It really is a great lisp. 

 

-Chris

0 Likes
Message 42 of 55

hmsilva
Mentor
Mentor

@Anonymous wrote:

Henrique,

 

     Thansk for all your help, this code has been working great. The time savings of running versus looking for mistakes myself is hours. It really is a great lisp. 

 

-Chris


You're welcome, Chris
Glad I could help 🙂

Henrique

EESignature

0 Likes
Message 43 of 55

nbawden
Advocate
Advocate

The lisp from post 38 is awesome though I found a small deficiency. If you have a gap within the specified tolerance but none of the objects are "orphaned" then the gap is overlooked. As an example in the attached image there are 4 lines that connect in pairs but the 2 pairs have a gap between them in between the max & min tolerance. I personally would love it if the lisp could detect this gap. Possible?

 

Gap.jpg

0 Likes
Message 44 of 55

Kent1Cooper
Consultant
Consultant

@nbawden wrote:

.... If you have a gap within the specified tolerance but none of the objects are "orphaned" then the gap is overlooked. ....


Yes, it's overlooked, because "orphaned" open ends are exactly what the routine is specifically looking for, and there are none in that situation.  What you're asking for would probably require a different approach -- I'm not sure how I would begin to go about it, but it may  be possible.

Kent Cooper, AIA
Message 45 of 55

nbawden
Advocate
Advocate

Thanks Kent - it would not be a common occurrence just thought I would query it.

0 Likes
Message 46 of 55

rock9
Enthusiast
Enthusiast

@hmsilva wrote:

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

Hi, Henrique,

 

maybe it would be succeeded to find gaps for cases from 29?

 

 


Quickly revised...

 

(vl-load-com)
(defun c:demo (/ *error* get_glob_real mk_circle flag 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 '((0 . "ARC,LINE,*POLYLINE,SPLINE"))))
                   )
                  (if (setq ss2 (ssget "_C" pt pt '((0 . "ARC,LINE,*POLYLINE,SPLINE"))))
                     (progn
                        (repeat (setq i (sslength ss2))
                           (setq hnd  (ssname ss2 (setq i (1- i)))
                                 obj  (vlax-ename->vla-object hnd)
                                 pt_a (vlax-curve-getstartpoint hnd)
                                 pt_b (vlax-curve-getendpoint hnd)
                           )
                           (if (or (equal pt_a pt 1e-6)
                                   (equal pt_b pt 1e-6)
                               )
                              (setq ori hnd)
                           )
                        )
                        (setq flag nil)
                        (repeat (setq i (sslength ss1))
                           (setq hnd (ssname ss1 (setq i (1- i)))
                                 obj (vlax-ename->vla-object hnd)
                           )
                           (if (and (ssmemb hnd ss)
                                    (not (eq ori hnd))
                                    (<= (distance (vlax-curve-getClosestPointTo obj pt) pt) *_min_fuzz)
                               )
                              (setq flag T)
                           )
                        )
                        (if (null flag)
                           (repeat (setq i (sslength ss1))
                              (setq hnd (ssname ss1 (setq i (1- i)))
                                    obj (vlax-ename->vla-object hnd)
                              )
                              (if (ssmemb hnd ss)
                                 (progn
                                    (if (and (not (eq ori hnd))
                                             (<= *_min_fuzz (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


 

 

This one, post #38, although loads successfully but when I type gap, dimgap command gets activated. What should I do to use this? I am using Autocad 2020. I'm using Windows 10 (64 bit) - 1903.

0 Likes
Message 47 of 55

ВeekeeCZ
Consultant
Consultant

@rock9 wrote:

This one, post #38, although loads successfully but when I type gap, dimgap command gets activated. What should I do to use this? I am using Autocad 2020. I'm using Windows 10 (64 bit) - 1903.


 

Read THIS how to load and run a LISP because you are not doing that right.

Message 48 of 55

rock9
Enthusiast
Enthusiast

@ВeekeeCZ wrote:

@rock9 wrote:

This one, post #38, although loads successfully but when I type gap, dimgap command gets activated. What should I do to use this? I am using Autocad 2020. I'm using Windows 10 (64 bit) - 1903.


 

Read THIS how to load and run a LISP because you are not doing that right.


I used this method only. Still no success with the command.  It loads successfully in the load box by showing notification that I initially mentioned...

 

SCREEN2.png

 

 

0 Likes
Message 49 of 55

hmsilva
Mentor
Mentor

@rock9 wrote:

...

 

This one, post #38, although loads successfully but when I type gap, dimgap command gets activated. What should I do to use this? I am using Autocad 2020. I'm using Windows 10 (64 bit) - 1903.


You have to type demo...

 

Hope this helps,
Henrique

 

EESignature

0 Likes
Message 50 of 55

rock9
Enthusiast
Enthusiast

@hmsilva wrote:

@rock9 wrote:

...

 

This one, post #38, although loads successfully but when I type gap, dimgap command gets activated. What should I do to use this? I am using Autocad 2020. I'm using Windows 10 (64 bit) - 1903.


You have to type demo...

 

Hope this helps,
Henrique

 


 

aaah!! I see. I was following instructions from the original post therefore made this mistake. I am zero in LISP. Thanks for this great script. Super awesome. So if I want to change the command to activate by typing 'gap', what do I do? 

0 Likes
Message 51 of 55

rock9
Enthusiast
Enthusiast

Another query.

 

I want to load this script everytime I start a new drawing or existing drawing. There is no ACADDOC.LSP file on my computer in which I can add your code.


I came to know about it after reading on this page

https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2020/ENU/AutoCAD-Customization...

 

There is an acad2020doc.lsp which I found on my laptop.

Here is it full location.

 

C:\Program Files\Autodesk\AutoCAD 2020\Support\en-us\acad2020doc.lsp


Should I paste this code to that file directly?

0 Likes
Message 52 of 55

hmsilva
Mentor
Mentor

@rock9 wrote:

...


 

aaah!! I see. I was following instructions from the original post therefore made this mistake. I am zero in LISP. Thanks for this great script. Super awesome. So if I want to change the command to activate by typing 'gap', what do I do? 


You're welcome!

If you had read Lee Mac´s article  @ВeekeeCZ  have posted in msg 47 it would be easy to determine where the command name would be defined...

 

Change

(defun c:demo (...

to

(defun c:gap (...

 

Regarding acaddoc.lsp read Lee Mac´s article  also.

 

Hope this helps,
Henrique



Henrique

EESignature

Message 53 of 55

ВeekeeCZ
Consultant
Consultant

HERE is more info about acaddoc and one very important note about acad2020doc.lsp

0 Likes
Message 54 of 55

Anonymous
Not applicable

The 3rd last modified lisp work greatly for me. Thanks.

0 Likes
Message 55 of 55

Leo_Gambini
Contributor
Contributor

I dodnt know why the circles not create?, some idea;

above command line pass; (why choosse _D???)

Enter Maximum Gap <1.000>:
Enter Minimum Gap <0.001>:
Enter Circle Size <20.00>:
Select objects or <ENTER> for all:
Select objects: Specify opposite corner: 29 found
Select objects:
_.-view Enter an option [?/Delete/Orthographic/Restore/Save/sEttings/Window]: _R Enter view name to restore: temp_h _.-view Enter an option [?/Delete/Orthographic/Restore/Save/sEttings/Window]: _D
Enter view name(s) to delete: temp_h

0 Likes