Find and Mark Gaps-Lisp Repair

Find and Mark Gaps-Lisp Repair

Anonymous
Not applicable
14,883 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,884 Views
54 Replies
Replies (54)
Message 21 of 55

Kent1Cooper
Consultant
Consultant

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

... 

Results for some reason depend on the zoom. ....


I have an idea that may overcome that problem.  As before, locate each endpoint of open-ended objects, and do (ssget "_C") around each endpoint with a crossing window only at the larger "gap size," to find things that are within that range of the endpoint for the routine to consider.  Then here's the difference in approach:

 

Make two temporary Circles centered on the open endpoint, one with the larger "gap size" value as the radius, and one with the smaller "fluff" value as the radius.  For each object that (ssget) found, run the VLA intersectwith method with the object and each of those temporary Circles.

 

If it returns an intersection point for the "gap size" Circle, then that object comes within the "gap size" distance of the endpoint, and should be further considered.  [Because the (ssget) crossing window will be square, and this test will be with a Circle, objects reaching inside the corners of that square but farther away than the "gap size" will be eliminated by this.]

 

If it returns an intersection point for the smaller "fluff"-radius Circle with any of those potential objects, then some object comes within the "fluff" distance and the location should not be marked.  If it doesn't for any of those potential objects, then there is a gap in the size range that the location should be marked.

 

Delete the two temporary Circles, or if the location should be marked, perhaps delete only the smaller one and increase the radius of the larger one to serve as the marker, if that's any easier than making a new marker Circle.

 

I believe [without putting together the code to try it] that the intersectwith method will not be affected by Zoom level, so this approach should work.  I would think the effect of being Zoomed too far out would be that (ssget) might sometimes find more than it needs to, rather than less, and the intersectwith method with the larger temporary Circle should dismiss any (ssget) may have found that it doesn't really need to consider.

 

It does, however, depend on things truly intersecting in 3D, so if Z-axis differences are a possibility as I see brought up in other Posts, this won't do the trick unless things are FLATTENed first or something.

Kent Cooper, AIA
0 Likes
Message 22 of 55

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

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 **

Alexander, I can't reproduce that error, did you run the 'demo' without any modification?


@АлексЮстасу wrote:
... 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:

GAP-Test_polyline_spline-false_gap_2.png

...

 


Using a graphical selection mode, we'll have to objects visible in the drawing, so,

'But the principle of dependence on zoom etc it is impossible to avoid?'

Using ssget with a graphical selection mode, it will always be zoom dependent...

 

In the above image, the objects are lines, the code will test for other object within the 'Minimum Gap' and if finds one entmake a circle...

 

Henrique

 

EESignature

0 Likes
Message 23 of 55

Anonymous
Not applicable

This code has even less false positives, but I still get red circles where I shouldnt. Green circles are legitimate gaps, red circles are false gaps. gap-test3.JPG

0 Likes
Message 24 of 55

hmsilva
Mentor
Mentor

@Anonymous wrote:

This code has even less false positives, but I still get red circles where I shouldnt. Green circles are legitimate gaps, red circles are false gaps. 


Hi Chris,

I think you're replying to me, if not, please disregards my reply...

 

If you are referring to the 'demo' posted at message #19 you'll have to enter a 'Maximum Gap' according the objects you have in the dwg, for example, in the 'GAP-test_V2.dwg' you have an object, the 'I beam', with a minimum distance of 0.34, so, if you enter 0.3 as 'Maximum Gap', the code will not create false GAP's...

 

Hope this helps,
Henrique

EESignature

0 Likes
Message 25 of 55

АлексЮстасу
Advisor
Advisor

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

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 **

Alexander, I can't reproduce that error, did you run the 'demo' without any modification? 


On this inquiry:

Select objects or <ENTER> for all:
Select objects:

 I press Enter -->video

 


@hmsilva wrote:
Using a graphical selection mode, we'll have to objects visible in the drawing, so,

'But the principle of dependence on zoom etc it is impossible to avoid?'

Using ssget with a graphical selection mode, it will always be zoom dependent...

 

 


I - not to the programmer - for the general reasons not clearly, why to the program need zoom, etc? After all the program processes data without participation of the person, i.e. without need to see on the screen.
Use of zoom, etc leads not only to work delay. Probably, it complicates also the analysis of data - if at the same time there are both very big and very small elements if there are very fine details of elements, etc.?
Possibly, such approach can lead to processing errors? To impossibility in some cases to receive exact and full result? (For example how it happens to BOUNDARY?).


-- Alexander, private person, pacifist, english only with translator 🙂 --

Object-modeling _ odclass-odedit.com _ Help

0 Likes
Message 26 of 55

hmsilva
Mentor
Mentor

Alexander, I can't reproduce that error, did you run the 'demo' without any modification? 

I did test the code, with your 'GAP-Test_polyline_spline.dwg' in AutoCAD 2012/14/16 without error, I have not the slightest clue in what is causing that error in your end...

 

Henrique

EESignature

0 Likes
Message 27 of 55

АлексЮстасу
Advisor
Advisor

@hmsilva wrote:

Alexander, I can't reproduce that error, did you run the 'demo' without any modification? 


 

Oh, Henrique, I'm sorry! Exactly - I tried to look at the work program with the MLine and ellipses, and tried to add them in code.

Yes, after Enter all is processed!

 

But still there was a question about "polyline" from pieces.

If it was really the polyline, gap wouldn't be.

GAP-Test_line-short.png

 

Also there was a question about marking of gap=0.4 at max=1.0, min=0.5.

 

GAP-Test_polyline_spline-false_gap10-05.png


-- Alexander, private person, pacifist, english only with translator 🙂 --

Object-modeling _ odclass-odedit.com _ Help

0 Likes
Message 28 of 55

hmsilva
Mentor
Mentor

АлексЮстасу wrote:...
Also there was a question about marking of gap=0.4 at max=1.0, min=0.5.

GAP-Test_polyline_spline-false_gap10-05.png


That should already be fixed.

 


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

But still there was a question about "polyline" from pieces.

If it was really the polyline, gap wouldn't be.

GAP-Test_line-short.png

 

...


 Alexander,

there will always be cases, with one of the test I did use at the 'demo', that will generate false positives, I did use 'vlax-curve-getClosestPointTo' function to calculate the point on the near object, and get the distance to calculate the gap...

GAP.PNG

 

Using a Maximum Gap of 0.80, the 'vlax-curve-getClosestPointTo'  function will return a point on the near object at a distance of 0.77, a false positive...

 

The revised code:

 

(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,ELLIPSE"))))
                (setq ss (ssget "_X" (list '(0 . "ARC,LINE,*POLYLINE,SPLINE,ELLIPSE") (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,ELLIPSE"))))
                     (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))
                                       (<= *_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

EESignature

Message 29 of 55

АлексЮстасу
Advisor
Advisor
Hi, Henrique, yes, now done almost perfectly!


There is another extreme case are distinctions only in Z.
Such cases are not for polylines with elevation, sometimes for lines to the polylines

.GAP-Test_polyline_spline-z0_3.pngGAP-Test_polyline_spline-z0_2.png

GAP-Test_polyline_spline-z0_1.png

 

There yet are not gaps between the ends of polylines and their segments.

GAP-Test_polyline_self.png

 

Is it possible yet to add MLines?


-- Alexander, private person, pacifist, english only with translator 🙂 --

Object-modeling _ odclass-odedit.com _ Help

0 Likes
Message 30 of 55

Anonymous
Not applicable

Henrique,

 

         I finnaly got to play around with the code, and it works great. I understand now why its creating gap circles where I wasnt expecting them. 

 

Capture3.JPG

Like this example will produce a gap circle, because of the distance from the green corner to the peach line. However since the Peach line does fall on the green line I would like this to not get marked. If this is possible great, if this is far as we can go, I'll mark your lisp as a solution. It works good enough that I can use it for my purposes. Thanks for all your help. 

 

-Chris

0 Likes
Message 31 of 55

hmsilva
Mentor
Mentor

@Anonymous wrote:

Henrique,

 

         I finnaly got to play around with the code, and it works great. I understand now why its creating gap circles where I wasnt expecting them. 

 

 

Like this example will produce a gap circle, because of the distance from the green corner to the peach line. However since the Peach line does fall on the green line I would like this to not get marked. If this is possible great, if this is far as we can go, I'll mark your lisp as a solution. It works good enough that I can use it for my purposes. Thanks for all your help. 

 

-Chris


You're welcome, Chris!

 

I did made some untested modifications to the 'demo' (I'm a very big workload), probably the previous situation It is already corrected.

 

(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,ELLIPSE"))))
                (setq ss (ssget "_X" (list '(0 . "ARC,LINE,*POLYLINE,SPLINE,ELLIPSE") (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,ELLIPSE"))))
                     (progn
                        (setq ori  (ssname ss2 0)
                              flag nil
                        )
                        (repeat (setq i (sslength ss1))
                           (setq hnd (ssname ss1 (setq i (1- i)))
                                 obj (vlax-ename->vla-object hnd)
                           )
                           (if (and (not (eq ori hnd))
                                    (vlax-curve-getParamAtPoint obj pt)
                               )
                              (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)
                                 (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

EESignature

0 Likes
Message 32 of 55

Anonymous
Not applicable

New code errors out where old code did not. 

 

** Error: bad argument value: AcDbCurve 1500 **

 

-Chris

0 Likes
Message 33 of 55

hmsilva
Mentor
Mentor

@Anonymous wrote:

New code errors out where old code did not. 

 

** Error: bad argument value: AcDbCurve 1500 **

 

-Chris


By bad....

 

Try the following revised 'demo'...

Chris, I'll have to test the 'demo', later I'll post it..

 

Ok, 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
                        (setq ori  (ssname ss2 0)
                              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))
                                    (vlax-curve-getParamAtPoint obj pt)
                               )
                              (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)
                                 (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

EESignature

0 Likes
Message 34 of 55

Kent1Cooper
Consultant
Consultant

@Kent1Cooper wrote:
.... I have an idea that may overcome that problem.  .... Make two temporary Circles centered on the open endpoint, one with the larger "gap size" value as the radius, and one with the smaller "fluff" value as the radius.  For each object that (ssget) found, run the VLA intersectwith method with the object and each of those temporary Circles. ....
I believe [without putting together the code to try it] that the intersectwith method will not be affected by Zoom level, so this approach should work. ....

For what it's worth at this point [it took me a while to work it out], here's a routine that takes that (vla-intersectwith) approach [attached GAP-ID.lsp with its GAPS command].

 

It does not erroneously identify any of the "false" locations in either your GAP-Test or GAP-Test_V2 drawings, nor in your Post 30 issue, so in that sense it "succeeds."  However, it appears my belief about the intersectwith method is not correct, i.e. it seems that Zoom level still has at least some [but apparently a lot less] influence, because when not Zoomed in, it marks only one of the two open ends at some of the legitimate gaps, whereas it marks both of them when Zoomed in closer.  But at least it does seem to identify where those gaps are, even if at some of them it draws only one identifying Circle.  If that turns out to be true in more extensive testing, that ought to be enough for your purposes.

 

[As mentioned at the end of Post 21, it would not work if a gap is in the manner of a Z-axis difference -- things must intersect truly in 3D.]

 

And of course, it could use *error* handling and some of the other typical stuff.

Kent Cooper, AIA
0 Likes
Message 35 of 55

АлексЮстасу
Advisor
Advisor

Hi, Henrique,

 

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

 

 


-- Alexander, private person, pacifist, english only with translator 🙂 --

Object-modeling _ odclass-odedit.com _ Help

0 Likes
Message 36 of 55

АлексЮстасу
Advisor
Advisor

Hi, Kent, thank You!

 

Now your lisp finds gaps, but not all. And for cases from 29, and some other.
But, probably, the main thing, what in big files your lisp can quicker work?

And still - lisp gives error if before start not all contents of the file on the screen are visible:

Command: GAPS
To find gaps, [<ENTER> for all],
Select objects:
_.layer
Current layer:  "GAP"
Enter an option [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Freeze/Thaw/LOck/Unlock/stAte/Description/rEconcile]: _thaw
Enter name list of layer(s) to thaw: GAP Enter an option [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Freeze/Thaw/LOck/Unlock/stAte/Description/rEconcile]: _make
Enter name for new layer (becomes the current layer) <GAP>: GAP Enter an option [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Freeze/Thaw/LOck/Unlock/stAte/Description/rEconcile]: _color
New color [Truecolor/COlorbook] : 1
Enter name list of layer(s) for color 1 (red) <GAP>: Enter an option [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Freeze/Thaw/LOck/Unlock/stAte/Description/rEconcile]:
Command:
Minimum Gap size to identify <0.0001>:
Maximum Gap size to identify <1.0000>:
Circle marker radius <2.0000>:
; error: bad argument type: lselsetp nil

-- Alexander, private person, pacifist, english only with translator 🙂 --

Object-modeling _ odclass-odedit.com _ Help

0 Likes
Message 37 of 55

hmsilva
Mentor
Mentor

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

Hi, Henrique,

 

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

 

 


Hi Alexander,

I'm a big workload, when I have some free time, I'll see what I can do.

 

Henrique

EESignature

0 Likes
Message 38 of 55

hmsilva
Mentor
Mentor
Accepted solution

@АлексЮстасу 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

EESignature

Message 39 of 55

АлексЮстасу
Advisor
Advisor

Hi, Henrique,

 


@hmsilva wrote:

Quickly revised...


this revision finds almost everything!

At you full find of gaps in 3D turned out.

Though, still doesn't find gaps between the ends and segments of same polylines.
GAP-Test_polyline_self.png
And, predictably, the real file of only 1200 lines and polylines was made very long - 37 seconds.


-- Alexander, private person, pacifist, english only with translator 🙂 --

Object-modeling _ odclass-odedit.com _ Help

0 Likes
Message 40 of 55

hmsilva
Mentor
Mentor

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

Hi, Henrique,

this revision finds almost everything!

At you full find of gaps in 3D turned out.

Though, still doesn't find gaps between the ends and segments of same polylines.

...


Hi Alexander,

the method I did use to test same object, is, if not closed, test the distande from start point, to end point, therefore the gaps between the ends and segments of same polylines, never will be marked with this 'demo'.

'And, predictably, the real file of only 1200 lines and polylines was made very long - 37 seconds.'

 

Alexander, as I have said earlier, I will not rewrite the 'demo' to use another type of approach.

After all, 37 seconds to test only 1200 lines and polylines, it's not too long, if you try to find those gaps without a routine, it would take much longer!

 

This is as far as I go, already spent a lot of my free time in this 'demo'...

 

Hope this helps,
Henrique

EESignature

0 Likes