Thousands of intersections

Rob_Durham · ‎08-02-2017

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.

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

john.uhden · ‎08-02-2017

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

roland.r71 · ‎08-03-2017

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.

Kent1Cooper · ‎08-03-2017

@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

Anonymous · ‎08-03-2017

(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.

Anonymous · ‎08-03-2017

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)

Rob_Durham · ‎08-03-2017

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.

roland.r71 · ‎08-03-2017

@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 😉

roland.r71 · ‎08-03-2017

@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.

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.

Anonymous · ‎08-03-2017

Did you try the last one I posted?

roland.r71 · ‎08-03-2017

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.

Rob_Durham · ‎08-03-2017

@Anonymous

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

roland.r71 · ‎08-03-2017

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.

Anonymous · ‎08-03-2017

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

Rob_Durham · ‎08-03-2017

I tried this with 6 circles from the spreadsheet.

It created 23,395 points

A tad few more than I need.

Anonymous · ‎08-03-2017

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?

Anonymous · ‎08-03-2017

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)

Rob_Durham · ‎08-03-2017

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

Anonymous · ‎08-03-2017

@Rob_Durham Happy to help!

Cheers

roland.r71 · ‎08-03-2017

@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 😉

Community

Thousands of intersections

Thousands of intersections

Thousands of intersections