Thousands of intersections

Thousands of intersections

Rob_Durham
Enthusiast Enthusiast
4,788 Views
64 Replies
Message 1 of 65

Thousands of intersections

Rob_Durham
Enthusiast
Enthusiast

Hi,

 

I am trying to get AutoCAD to draw a great many circles of differing radii with the centre point of the circles at a common foci point along the semi-major axis of an ellipse. The radius of all the circles are such that they will intersect the ellipse at some point.

 

The XYZ coordinates of these intersections are ultimately what I want to extract using AutoCADs data extraction utility.

 

I have successfully used Lee Macs intersections Lisp routine to draw ‘points’ at these intersections however it doesn’t like it when I have thousands of circles….it just crashes.

 

;; Intersections in Set  -  Lee Mac
;; Returns a list of all points of intersection between all objects in a supplied selection set.
;; sel - [sel] Selection Set

(defun LM:intersectionsinset ( sel / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength sel))
        (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
        (repeat (setq id2 id1)
            (setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
)

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

(defun c:interset ( / sel )
    (if (setq sel (ssget))
        (foreach pnt (LM:intersectionsinset sel)
            (entmake (list '(0 . "POINT") (cons 10 pnt)))
        )
    )
    (princ)
)
(vl-load-com) (princ)

 

 

Since I don’t ultimately need the circles (only the intersection points they make with the ellipse) I thought I would try using the lisp below to delete the last circle drawn (actually the second to last entity after the ‘point’) which seems to work if I run it manually. This way, the first lisp routine only needs to find one intersection each time.

 

 

(defun countback(steps / ms)
(vl-load-com)
(setq ms (vla-get-modelspace (vla-get-activedocument
(vlax-get-acad-object))))
(vlax-vla-object->ename (vla-item ms (- (vla-get-count ms) steps)))
)
 (command ".erase" (countback 2) "")
(princ)

 

 

The trouble is I am using a copy paste method from excel to the command line to draw the circles. I thought I would try and also call the above routines from the spreadsheet but I can’t seem to get it to work, it will draw the points at the intersections but then won’t delete the last circle drawn.

 

Capture.JPG

 

Since I’m no expert in Lisp and I found both of these routines on the web, can someone possibly a) help me combine them into 1 lisp adding the erase command to delete the 2nd to last entity (countback 2) or b) suggest a better way of doing this whole process?

 

Thanks in advance

 

Rob

0 Likes
Accepted solutions (1)
4,789 Views
64 Replies
Replies (64)
Message 2 of 65

john.uhden
Mentor
Mentor

I'll leave the object creation/selection up to you, but if say Obj1 is the ellipse, and Obj2 is any circle, then

 

(setq ips (vlax-invoke obj1 'intersectwith obj2 0))

 

will return a flat list of the intersection points, as in (x1 y1 z1 x2 y2 z2).

 

Then you can use my @group function to convert the flat list into a list of 3D points...

 

(defun @group (old n / item new)
  (while old
    (while (< (length item) n)
      (setq item (cons (car old) item) old (cdr old))
    )
    (setq new (cons (reverse item) new) item nil)
  )
  (reverse new)
)

such that (@group ips 3) will return ((x1 y1 z1)(x2 y2 z2))

 

John F. Uhden

0 Likes
Message 3 of 65

roland.r71
Collaborator
Collaborator

Another way (easier, imho):

 

After creating the circle use:

(setq lastCirc (ssget "L"))

to store it (Last object added) into a selection set.

 

After creating the points use:

(command "_.erase" lastCirc "")

 To delete it.

0 Likes
Message 4 of 65

Kent1Cooper
Consultant
Consultant

@roland.r71 wrote:

.... 

After creating the circle use:

(setq lastCirc (ssget "L"))

to store it (Last object added) into a selection set.

....


Or:

 

(setq lastCirc (entlast))

Kent Cooper, AIA
0 Likes
Message 5 of 65

Anonymous
Not applicable
(defun c:DeleteCountback(steps / ms)
(vl-load-com)
(setq ms (vla-get-modelspace (vla-get-activedocument
(vlax-get-acad-object))))
(entdel (vlax-vla-object->ename (vla-item ms (- (vla-get-count ms) steps))))
)

 You could change out countback with this and call it like a command.

0 Likes
Message 6 of 65

Anonymous
Not applicable

I updated some of your code so you can have one line for each time you get the intersections and it includes drawing your circle. Should work fine. I tested it couple times.

 

;; Intersections in Set  -  Lee Mac
;; Returns a list of all points of intersection between all objects in a supplied selection set.
;; sel - [sel] Selection Set

(defun LM:intersectionsinset ( sel / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength sel))
        (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
        (repeat (setq id2 id1)
            (setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
)

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

(defun c:intersetGivenCircleRadius ( / sel )
  (defun Circle (cen rad)
  (entmakex (list (cons 0 "CIRCLE")
                  (cons 10 cen)
                  (cons 40 rad))))

  
  ;;Updated this portion to select all
  (setq CirRad (getreal "\nEnter the radius of the circle."))
  (if CirRad
    (progn
      (circle '(0 0 0) cirrad)
      (setq myCir (entlast))
    (if (setq sel (ssget "_A" (list(cons 410 (getvar 'ctab)))))
        (foreach pnt (LM:intersectionsinset sel)
            (entmake (list '(0 . "POINT") (cons 10 pnt)))
        ))
(entdel myCir)

      )
    )
    (princ)
)
(vl-load-com) (princ)
0 Likes
Message 7 of 65

Rob_Durham
Enthusiast
Enthusiast

Thanks for the suggestions guys.

 

It seems to me that the easiest way would be to substitute the countback function with the simple

 

 

 (setq lastCirc (ssget "L")) 

 

and

 

(command "_.erase" lastCirc "")

 

suggested by Roland and again I can get this working if I run it at the command line ie. copy and paste the individual lines of code however if I try to add the code to the Lee Mac intersection code below it doesn't work, it retains all the circles and creates points for every intersection between every circle and the ellipse.

 

Where abouts within the code below should I add the two lines above?

 

(defun LM:intersectionsinset ( sel / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength sel))
        (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
        (repeat (setq id2 id1)
            (setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
			
            )
        )
    )
    (apply 'append (reverse rtn))
)
(setq lastCirc (entlast))
(defun c:interset ( / sel )
    (if (setq sel (ssget))
        (foreach pnt (LM:intersectionsinset sel)
            (entmake (list '(0 . "POINT") (cons 10 pnt)))
        )
    )
       
    (princ)
)
(vl-load-com) (princ)

 

Bearing in mind my excel sheet now looks like this.

 

Capture.JPG

0 Likes
Message 8 of 65

roland.r71
Collaborator
Collaborator

@Kent1Cooper wrote:

@roland.r71 wrote:

.... 

After creating the circle use:

(setq lastCirc (ssget "L"))

to store it (Last object added) into a selection set.

....


Or:

 

(setq lastCirc (entlast))


I tried that first, but doesn't work, as it is an entity, not a selectionset. (so erase says: *invalid selection*)

Adding entget doesn't help. So, you need to turn it into a set. Which i did 😉

0 Likes
Message 9 of 65

roland.r71
Collaborator
Collaborator

@Rob_Durham wrote:

Thanks for the suggestions guys.

 

It seems to me that the easiest way would be to substitute the countback function with the simple

 

 

 (setq lastCirc (ssget "L")) 

 

and

 

(command "_.erase" lastCirc "")

 

suggested by Roland and again I can get this working if I run it at the command line ie. copy and paste the individual lines of code however if I try to add the code to the Lee Mac intersection code below it doesn't work, it retains all the circles and creates points for every intersection between every circle and the ellipse.

 

Where abouts within the code below should I add the two lines above?

 

(defun LM:intersectionsinset ( sel / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength sel))
        (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
        (repeat (setq id2 id1)
            (setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
			
            )
        )
    )
    (apply 'append (reverse rtn))
)
(setq lastCirc (entlast))
(defun c:interset ( / sel )
    (if (setq sel (ssget))
        (foreach pnt (LM:intersectionsinset sel)
            (entmake (list '(0 . "POINT") (cons 10 pnt)))
        )
    )
       
    (princ)
)
(vl-load-com) (princ)

 

Bearing in mind my excel sheet now looks like this.

 

Capture.JPG


You need to put it inside the/a function. It is currently between 2 function definitions...

 

So currently you define a function, get the selection & define another function. (defining a function is not the same as executing it)

 

(do it) like this:

(defun c:interset ( / sel )
    (setq lastCirc (ssget "L"))
    (if (setq sel (ssget))
        (foreach pnt (LM:intersectionsinset sel)
            (entmake (list '(0 . "POINT") (cons 10 pnt)))
        )
    )
    (command "_.erase" lastCirc "")
    (princ)
)

 edit:

Woops, copied the entlast, instead of (ssget "L") - which is not the same

Entlast just gets the last added entity.

ssget "L" creates a selectionset with the last added entity.

0 Likes
Message 10 of 65

Anonymous
Not applicable

Did you try the last one I posted?

0 Likes
Message 11 of 65

roland.r71
Collaborator
Collaborator

Just to inform:

While testing i noticed that if the elipse & circle have overlapping insertionpoints, it will create a point there too.

So i got 5 instead of the expected 4 intersection points.

0 Likes
Message 12 of 65

Rob_Durham
Enthusiast
Enthusiast

@Anonymous

 

Yes I tried yours. Does this work in conjuction with my spreadsheet or would I need to enter the circle radii manually?

0 Likes
Message 13 of 65

roland.r71
Collaborator
Collaborator

made a small copying error there with my solution. Just corrected it.

 

so the entire thing should look like this:

;; Intersections in Set  -  Lee Mac
;; Returns a list of all points of intersection between all objects in a supplied selection set.
;; sel - [sel] Selection Set

(defun LM:intersectionsinset ( sel / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength sel))
        (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
        (repeat (setq id2 id1)
            (setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
)

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

(defun c:interset ( / sel )
    (setq lastCirc (ssget "L"))
    (if (setq sel (ssget))
        (foreach pnt (LM:intersectionsinset sel)
            (entmake (list '(0 . "POINT") (cons 10 pnt)))
        )
    )
    (command "_.erase" lastCirc "")
    (princ)
)
(vl-load-com) (princ)

although it doesn't seem to matter, as using the entget didn't work from the command line, but it did just work fine from inside the lisp function.

Message 14 of 65

Anonymous
Not applicable

@Rob_Durham Your spreadsheet would only have the command name then the radius of the circle, then the same on the next line.

 

 

image.png

 

 

0 Likes
Message 15 of 65

Rob_Durham
Enthusiast
Enthusiast

I tried this with 6 circles from the spreadsheet.

 

It created 23,395 pointsSmiley Surprised

 

A tad few more than I need.

0 Likes
Message 16 of 65

Anonymous
Not applicable

Smiley Surprised

 

I didn't change any of lee's code, so that should not have changed. Without seeing what you are working with, it's difficult.

 

Can you try one at a time and let me know what happens?

0 Likes
Message 17 of 65

Anonymous
Not applicable
Accepted solution

I didn't remember to remove points from the items that get evaluated! For some reason it didn't do the same when you ran the code the way you did.

 

;; Intersections in Set  -  Lee Mac
;; Returns a list of all points of intersection between all objects in a supplied selection set.
;; sel - [sel] Selection Set

(defun LM:intersectionsinset ( sel / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength sel))
        (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
        (repeat (setq id2 id1)
            (setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
)

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

(defun c:intersetGivenCircleRadius ( / sel )
  (defun Circle (cen rad)
  (entmakex (list (cons 0 "CIRCLE")
                  (cons 10 cen)
                  (cons 40 rad))))

  
  ;;Updated this portion to select all
  (setq CirRad (getreal "\nEnter the radius of the circle."))
  (if CirRad
    (progn
      (circle '(0 0 0) cirrad)
      (setq myCir (entlast))
    (if (setq sel (ssget "_A" (list(cons 410 (getvar 'ctab)) (cons 0 "~POINT"))))
        (foreach pnt (LM:intersectionsinset sel)
            (entmake (list '(0 . "POINT") (cons 10 pnt)))
        ))
(entdel myCir)

      )
    )
    (princ)
)
(vl-load-com) (princ)
Message 18 of 65

Rob_Durham
Enthusiast
Enthusiast

Thanks zraboin, it works.

 

Roland, your method was also evaluating the points themselves as intersections and giving me the exact same quantity.

 

Thank you to you both

0 Likes
Message 19 of 65

Anonymous
Not applicable

@Rob_Durham Happy to help!

 

Cheers

0 Likes
Message 20 of 65

roland.r71
Collaborator
Collaborator

@Rob_Durham wrote:

Thanks zraboin, it works.

 

Roland, your method was also evaluating the points themselves as intersections and giving me the exact same quantity.

 

Thank you to you both


Chips. yeah, i get it.

I tested by selecting the objects, but your script uses "ALL"

The "all" in the selection includes the points & they all intersect with the elipse, ...so it will increase cumulative... oops.

 

oh well, at least you have your solution, that's what counts 😉

0 Likes