Intersection points if objects are inside of blocks

eakos1 · ‎11-30-2023

Hello,

there is a code from Lee Mac to find intersection points. I've tried to make it work if the objects are inside a block - but unfortunately it not works. Only if the objects are not in a block.

I'm using the nentsel for selection and after that I'm creating the selection set.

For me this is suspicious:

(ssadd (car a) sel)

Can be, that objects cannot be added to a selection set if it is in a block?

Do someone any idea how could work this code?

(defun c:interset_LM ( / a sel )
  (setq sel (ssadd))
  (while
	(setq a (nentsel "\nPick the object's one by one (It can be insed of a block too): "))
	(ssadd (car a) sel)
    );while

  (if (not (not sel))
        (foreach pnt (LM:intersectionsinset sel)
            (entmake (list '(0 . "POINT") (cons 10 pnt)))
        )
    )
    (princ)

(vl-load-com)
(princ)
); defun


------------------------------------------------------------------------------------------------
------------------------------------------------------------------------------------------------
SUB programs
------------------------------------------------------------------------------------------------
------------------------------------------------------------------------------------------------


;; 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)
            )
        ); repeat
    ); repeat
    (apply 'append (reverse rtn))
)


;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

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

eakos1 · ‎11-30-2023

I've made further investigations - I think it will not work this idea.

I've rewritten my code for two items, it works but the points are in wrong position.

I've selected two objects in the same block.

(defun c:interset_LM ( / a b )

	(setq a ( car (nentsel "\nPick the object's one by one (It can be insed of a block too): ")))

	(setq b ( car (nentsel "\nPick the object's one by one (It can be insed of a block too): ")))
 

  (if (and (not (not a)) (not (not b)) )
        ( foreach pnt (LM:intersectionsinset-RDI a b)
            (entmake (list '(0 . "POINT") (cons 10 pnt)))
        )
    )
    (princ)

(vl-load-com)
(princ)
); defun


------------------------------------------------------------------------------------------------
------------------------------------------------------------------------------------------------
SUB programs
------------------------------------------------------------------------------------------------
------------------------------------------------------------------------------------------------


;; 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)
            )
        ); repeat
    ); repeat
    (apply 'append (reverse rtn))
)


;; 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-RDI ( a b / 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)
;;;	  
;;;            
;;;            )
;;;	  
;;;        ); repeat
;;;
;;;      
;;;    ); repeat
    (setq a (vlax-ename->vla-object a))
    (setq b (vlax-ename->vla-object b))
  
    (setq rtn (cons (LM:intersections a b acextendnone) rtn))
    (apply 'append (reverse rtn))
)




;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

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

Sea-Haven · ‎11-30-2023

A circle intersecting a line will always return 2 points. Only a single point if its a end point touching a circle. That is a function of the intersectwith. You can check how many xyz are returned so only use 1st 3.

eg xyz x 4

eakos1 · ‎12-01-2023

Sorry, but I couldn't catch what it is to do with my problem. The number of the points are OK. Only the positions are wrong.

Here the problem is caused by the BLOCK.

I've made further check.

If I make blocks from the objects - points are in a good position
But if I make a copy of the blocks - point will in the original position
Even though the objects are not crossing eachother, the program will find the intersection points in the original position

I'm afraid there is no solution to find the intersection points if object are inside of a BLOCK.

Unless if the object would be temporary removed from the block, find the intersection points and objects moved back inside the blocks. Or somehow make a copy from the object in the same position outside of the block, find the intersections and delete the new object.

komondormrex · ‎12-02-2023

hey,

@eakos1 wrote:
it works but the points are in wrong position.

that is because you nentselect objects which belong to block definition which in its turn has own coordinate system and in which the intersection points will be drawn with regards to the current ucs. therefore every insert you refer will refer to same identical block definition entities in every same position.

@eakos1 wrote:
I'm afraid there is no solution to find the intersection points if object are inside of a BLOCK.

there is, depends on the objective. not immaculate, but draws points at the intersections in wcs and some other restrictions.

;*******************************************************************************************************************************************

(defun make_points (coordinates_raw_list / point_list)
  	(if coordinates_raw_list
		(setq point_list (cons (list (car coordinates_raw_list) (cadr coordinates_raw_list) (caddr coordinates_raw_list))
				       (make_points (cdddr coordinates_raw_list))
				 )
		)
	)
  	point_list
)

;*******************************************************************************************************************************************

(defun c:mark_intersections (/ curve block curve_copy intersection_raw_list _point)
	(while (or (null curve)
   		   (not (wcmatch (cdr (assoc 0 (entget curve))) '"*LINE"))
	       )
  	       (setq curve (car (entsel "\rPick curve: ")))
	)
  	(setq curve (vlax-ename->vla-object curve))
  	(terpri)
	(while (or (null block)
	   	   (/= (cdr (assoc 0 (entget block))) "INSERT")
	       )
	       (setq block (car (entsel "\rPick block: ")))
	)
  	(setq block (vlax-ename->vla-object block)
	      curve_copy (vla-copy curve)
	)
	(vla-move curve_copy (vla-get-insertionpoint block) (vlax-3d-point '(0 0)))
	(vla-rotate curve_copy (vlax-3d-point '(0 0)) (* -1 (vla-get-rotation block)))
	(vlax-map-collection (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-effectivename block))
	  		    '(lambda (block_object) (setq intersection_raw_list
							  (append intersection_raw_list (vlax-invoke curve_copy 'intersectwith block_object acextendnone))
						    )
			     )
	)
	(vla-erase curve_copy)
	(foreach point (make_points intersection_raw_list)
	  (vla-move (setq _point (vla-addpoint (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
			    		       (vlax-3d-point point)
			         )
		    )
		    (vlax-3d-point '(0 0))
		    (vla-get-insertionpoint block)
	  )
	  (vla-rotate _point (vla-get-insertionpoint block) (vla-get-rotation block))
	)
  	(if intersection_raw_list
	  (princ (strcat "\nFound " (itoa (/ (length intersection_raw_list) 3)) " intersections."))
	  (princ (strcat "\nNo intersection found."))
  	)
  	(princ)
)

;*******************************************************************************************************************************************

Kent1Cooper · ‎12-02-2023

@komondormrex wrote:
that is because you nentselect objects which belong to block definition which in its turn has own coordinate system .... every insert you refer will refer to same identical block definition entities in every same position.

Exactly -- data about nested objects is stored in relation to the Block's insertion base point as the 0,0 origin, and intersection calculations would be similarly in relation to the insertion base point in the Block definition, not the position of a particular Block reference. I would bet that it works right for a Block Inserted at 0,0, and with scale factors of 1 and rotation of 0.

Kent Cooper, AIA

eakos1 · ‎12-03-2023

Thank you @komondormrex . It really works. But only if one object is selected outside of a block and one full block is selec...

What I need, select two polylines what are inside different blocks, and find the intersection points only between this two polylines, not the whole block.

To rewrite this code to my need is over my knowledge.

komondormrex · ‎12-03-2023

in that case you may mark needed plines inside block with eg. dictionary record and sort them out when finding intersections.

eakos1 · ‎12-06-2023

Thanks but it helps me not. I don't know hot to "short them out".

What I would need, how can be one with nentsel selected object moved from inside the block to outside. I searched on the net but I couldn't find the solution.

komondormrex · ‎12-06-2023

well, check the rough layout

;*******************************************************************************************************************************************

(defun make_points (coordinates_raw_list / point_list)
  	(if coordinates_raw_list
		(setq point_list (cons (list (car coordinates_raw_list) (cadr coordinates_raw_list) (caddr coordinates_raw_list))
				       (make_points (cdddr coordinates_raw_list))
				 )
		)
	)
  	point_list
)

;*******************************************************************************************************************************************

(defun c:mark_intersections (/ curve bename bename_list block intersection_raw_list curve_copy _point)
	(while (or (null curve)
   		   (not (wcmatch (cdr (assoc 0 (entget curve))) '"*LINE"))
	       )
  	       (setq curve (car (entsel "\rPick curve: ")))
	)
  	(setq curve (vlax-ename->vla-object curve)
	      bename t
	)
  	(terpri)
	(while bename
	  (setq bename (nentsel "\nPick entity inside block: "))
	  (if (null (member (car bename) bename_list)) 
	  	(setq bename_list (append bename_list (list (car bename))))
    	  )
	  (if (and (null block) bename)
	    	(setq block (vlax-ename->vla-object (car (last bename))))
    	  )
	)
  	(setq curve_copy (vla-copy curve)
	      bename_list (mapcar 'vlax-ename->vla-object (vl-remove nil bename_list))
	)
	(vla-move curve_copy (vla-get-insertionpoint block) (vlax-3d-point '(0 0)))
	(vla-rotate curve_copy (vlax-3d-point '(0 0)) (* -1 (vla-get-rotation block)))
	(mapcar '(lambda (bename) (setq intersection_raw_list (append intersection_raw_list (vlax-invoke curve_copy 'intersectwith bename acextendnone))))
		 bename_list
	)
	(vla-erase curve_copy)
	(foreach point (make_points intersection_raw_list)
	  (vla-move (setq _point (vla-addpoint (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
			    		       (vlax-3d-point point)
			         )
		    )
		    (vlax-3d-point '(0 0))
		    (vla-get-insertionpoint block)
	  )
	  (vla-rotate _point (vla-get-insertionpoint block) (vla-get-rotation block))
	)
  	(if intersection_raw_list
	  (princ (strcat "\nFound " (itoa (/ (length intersection_raw_list) 3)) " intersections."))
	  (princ (strcat "\nNo intersection found."))
  	)
  	(princ)
)

;*******************************************************************************************************************************************

hosneyalaa · ‎12-06-2023

Can you attached example drawing

eakos1 · ‎12-06-2023

Here is a sample file.

There are two blocks here, red and white. In both are different objects.

I want to find the intersection points between the white circle and the red rectangular, both are in different blocks.

In this example file will be 4 intersection points.

Sea-Haven · ‎12-06-2023

Try this when asked pick white circle then red rectangle.

(defun c:wow ( / obj1 obj2 inspts lst)
(setq obj1 (vlax-ename->vla-object (car  (nentsel "Pick object 1 "))))
(setq obj2 (vlax-ename->vla-object (car  (nentsel "Pick object 2 "))))
(setq inspts (vlax-invoke obj2 'intersectWith obj1 acExtendThisEntity))
(setq x 0 lst '())
(repeat (/ (length inspts) 3)
  (setq lst (cons (list (nth x inspts)(nth (+ x 1) inspts) (nth (+ x 2) inspts)) lst))
  (setq x (+ x 3))
)
(princ lst)
(princ)
)
(C:wow)

Pick object 1 
Pick object 2 
((58.9574639748534 40.126192411934 0.0) (76.9219985554756 40.126192411934 0.0) (77.9016930688547 51.8918490084093 0.0) (57.9777694614742 51.8918490084093 0.0))

hosneyalaa · ‎12-06-2023

@eakos1

test



;;;  https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/extract-a-polyline-coordinates-from-wcs/td-p/9760011
(defun rh:sammlung_n (o_lst grouping / tmp n_lst)
  (setq n_lst nil)
  (if (= (rem (length o_lst) grouping) 0)
    (while o_lst
      (while (< (length tmp) grouping)
        (setq tmp   (cons (car o_lst) tmp)
              o_lst (cdr o_lst)
        )                                         ;end_setq
      )                                           ;end_while
      (setq n_lst (cons (reverse tmp) n_lst)
            tmp   nil
      )                                           ;end_setq
    )                                             ;end_while
    (princ
      "\nModulus Error : The passed list length is not exactly divisible by the group size!!"
    ) ;_ end of princ
  )                                               ;end_if
  (reverse n_lst)
) ;_ end of defun


(defun c:testintersect (/ 3PLIST CIRCLE INTERSECTLIST LWPOLYLINE X)

  (setq LWPolyline
         (vlax-ename->vla-object
           (car (nentsel "\nPick entity inside block: "))
         ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq
  (setq circle (vlax-ename->vla-object
                 (car (nentsel "\nPick entity inside block: "))  ;intersectWith nentsel
               ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq
  (setq intersectlist
         (vlax-invoke
           LWPolyline
           'intersectWith
           circle
           acextendthisentity
         ) ;_ end of vlax-invoke
  ) ;_ end of setq
  (setq 3plist (rh:sammlung_n intersectlist 3))
  (if (< 0 (length 3plist))
    (progn
      (mapcar '(lambda (x)
                 (entmakex
                   (list
                     '(0 . "POINT")
                     (cons 10 x)
                     (cons 8 "00-point")
                   ) ;_ end of list
                 ) ;_ end of entmakex
               ) ;_ end of lambda
              3plist
      ) ;_ end of mapcar
    ) ;_ end of progn
  ) ;_ end of if


  (princ)
) ;_ end of defun
;|«Visual LISP© Format Options»
(72 2 50 2 T "end of " 60 9 1 0 0 nil T nil T)
;*** DO NOT add text below the comment! ***|;

eakos1 · ‎12-06-2023

Thanks, but sorry, this program is jut like my on the top. Only works if the blocks are in the position where they were created. In this case my program works too.

But if I make a copy from the blocks the points will be always on the original block.

eakos1 · ‎12-06-2023

Thanks, I tried, but same problem, works only by the original block, by the copy not.

komondormrex · ‎12-07-2023

@eakos1 wrote:
There are two blocks here, red and white. In both are different objects.
I want to find the intersection points between the white circle and the red rectangular, both are in different blocks.

for selecting entities in the blocks only (copied/rotated). wdnywttys.

;*******************************************************************************************************************************************

(defun make_points (coordinates_raw_list / point_list)
  	(if coordinates_raw_list
		(setq point_list (cons (list (car coordinates_raw_list) (cadr coordinates_raw_list) (caddr coordinates_raw_list))
				       (make_points (cdddr coordinates_raw_list))
				 )
		)
	)
  	point_list
)

;*******************************************************************************************************************************************

(defun c:mark_intersections (/ curve bename bename_list block intersection_raw_list curve_copy _point)
  	(while (setq bename (nentsel "\nPick entity inside block: "))
		(if (null (member (car bename) bename_list)) 
	  		(setq bename_list (append bename_list (list (car bename))))
		)
		(if (and (null block) bename)
			(setq block (vlax-ename->vla-object (car (last bename))))
		)
	)
  	(setq bename_list (mapcar 'vlax-ename->vla-object (vl-remove nil bename_list)))
	(mapcar '(lambda (bename) (setq intersection_raw_list (append intersection_raw_list (vlax-invoke (car bename_list) 'intersectwith bename acextendnone))))
		 (cdr bename_list)
	)
	(foreach point (make_points intersection_raw_list)
		(vla-move (setq _point (vla-addpoint (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
			    		             (vlax-3d-point point)
			               )
		          )
		    	  (vlax-3d-point '(0 0))
		    	  (vla-get-insertionpoint block)
		)
	  	(vla-rotate _point (vla-get-insertionpoint block) (vla-get-rotation block))
	)
  	(if intersection_raw_list
		(princ (strcat "\nFound " (itoa (/ (length intersection_raw_list) 3)) " intersections."))
		(princ (strcat "\nNo intersection found."))
  	)
  	(princ)
)

;*******************************************************************************************************************************************

Community

Intersection points if objects are inside of blocks

Intersection points if objects are inside of blocks

Intersection points if objects are inside of blocks