Intersection Of Lines By Layers

Hi Guys,

My situation is i have a number of splines that are in different layers. I have intersected these lines with a number of lines in the '0' layer.

I want to be able to extract the intersection points in x,y,z format.

My current procedure is to select the layer of the curve i want, use the below lisp, repeat for all lines, use DATAEXTRACTION to get the x,y,z sorted by layers.

Currently INTLINES finds intersection points of any lines and places a point there.

I need the lisp to create points in the layer of the line that is being intersected? Can anyone help me with this?

(vl-load-com)
;;-----------------------------------------------
;; CDNC5-02.LSP
;; Bill Kramer
;; (modifications and enhancements by CAD Studio, www.cadstudio.cz , 2010-2014)
;;
;; ILSIMPLEMODE = T  for single intersection only  (large coord problem)
;;
;; Find all intersections between objects in
;; the selection set SS.
;;
;; ---------------------------------------------- BEGIN LISTING 1
;;
(defun get_all_inters_in_SS (SS /
		     SSL ;length of SS
		     PTS ;returning list
		     aObj1 ;Object 1
		     aObj2 ;Object 2
		     N1  ;Loop counter
		     N2  ;Loop counter
		     iPts ;intersects
			 C1 C2 C3
		     )

(defun iL->L (iPts / Pts) ; convert coordlist -> pointlist
(while (> (length iPts) 0)
 (setq Pts (cons (list	(car iPts)
					(cadr iPts)
					(caddr iPts))
				Pts)
    iPts (cdddr iPts)))
Pts
)
(defun iL2->L (iPts / Pts) ; convert coordlist -> pointlist 2D
(while (> (length iPts) 0)
 (setq Pts (cons (list	(car iPts)
					(cadr iPts)
					'0.0)
				Pts)
    iPts (cddr iPts)))
Pts
)

(defun DelDup ( l / x r ) ; remove duplicates
   (while l
       (setq x (car l)
             l (vl-remove x (cdr l))
             r (cons x r)
       )
   )
   (reverse r)
)


 (setq N1 0 ;index for outer loop
SSL (sslength SS))
 ; Outer loop, first through second to last
 (while (< N1 (1- SSL)) ;  nebo <= ?
   ; Get object 1, convert to VLA object type
   (setq aObj1 (ssname SS N1)
  aObj1 (vlax-ename->vla-object aObj1)
  N2 (1+ N1)) ;index for inner loop
  ; self-intersections:
(if (vlax-property-available-p aObj1 'Coordinates)(progn ; is it a curve? LWPOLY
	(setq C1 (iL2->L (vlax-get aObj1 'Coordinates)))
	(setq C2 (iL->L (vlax-invoke aObj1 'IntersectWith aObj1 0)))
	(setq C3 (vl-remove-if '(lambda ( x ) (member x C1)) C2))
;		(PRINT C1)(PRINT C2)(PRINT C3)
	(if C3 (foreach x C3 (setq Pts (cons x Pts)))) ; add selfs
))
(if (= (vlax-get aObj1 'ObjectName) "AcDbSpline")(progn ; SPLINE
	(setq C1 (iL->L (vlax-invoke aObj1 'IntersectWith aObj1 0)))
;		(PRINT C1)
	(if C1 (foreach x C1 (setq Pts (cons x Pts)))) ; add selfs
))
   ; Inner loop, go through remaining objects
   (while (< N2 SSL) ; innser loop
     ; Get object 2, convert to VLA object
     (setq aObj2 (ssname SS N2)
    aObj2 (vlax-ename->vla-object aObj2)
    ; Find intersections of Objects
    iPts (vla-intersectwith aObj1
	   aObj2 0)
    ; variant result
    iPts (vlax-variant-value iPts))
     ; Variant array has values?
     (if (> (vlax-safearray-get-u-bound iPts 1)
     0)
(progn ;array holds values, convert it
  (setq iPts ;to a list.
	 (vlax-safearray->list iPts))
  ;Loop through list constructing points
;	  (setq Pts (iL->L iPts)) ; must be global
;(if (> (length iPts) 3)(PRINT iPts)) --- LIST DUPLICATE INTERSECTIONS - THE RED/GREEN CASE GIVES TWO INTERSECTIONS !
  (while (> (length iPts) 0)
    (setq Pts (cons (list (car iPts)
			  (cadr iPts)
			  (caddr iPts))
		    Pts)
	  iPts (cdddr iPts))
	(if ILSIMPLEMODE (setq iPts nil))  ; ILSIMPLEMODE - take only the first intersection
  )
))
     (setq N2 (1+ N2))) ;inner loop end
   (setq N1 (1+ N1))) ;outer loop end
 Pts) ;return list of points found
;;-----------------------------------------------   END LISTING 1
;;
;; Remaining lines of code for download version, used to demonstrate and test the utility in Listing 1.
;;
;; Process - Create drawing with intersecting lines and lwpolylines.
;;           Load function set
;;           Run command function INTLINES
;;           Intersections are marked with POINT objects on current layer
;;
(defun C:INTLINES ( / SS1 PT ptl oldos)
 (prompt "\nINTLINES running to demonstrate GET_ALL_INTERS_IN_SS function.")
 (setq SS1 (ssget);(ssget "_X");(get_all_lines_as_SS)
PTS (get_all_inters_in_ss SS1)
       )
 (setq ptl (length PTS)   PTS (deldup PTS)) ; duplicates - shouldn't be any
 (if (> ptl (length PTS)) (princ (strcat "\n" (itoa (- (length PTS) ptl)) " duplicates removed")))
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (setvar "CMDECHO" 0)
 (setq oldos (getvar "OSMODE"))(setvar "OSMODE" 0)
 (foreach PT PTS ;;Loop through list of points
   (command "_POINT" PT)) ;;Create point object (you can also use INSERT, CIRCLE, etc. here)
 (setvar "PDMODE" 34) ;;display points so you can see them
 (command "_REGEN")
 (setvar "OSMODE" oldos)
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (princ (strcat (itoa (length PTS)) " intersections found."))
 (princ)
)
;;
;;-----------------------------------------------
;;  Get all lines and lwpolyline objects in the
;;  drawing and return as a selection set.
;;
(defun get_all_Lines_as_SS ()
 (ssget "_X" '((0 . "LINE,LWPOLYLINE"))))
;;

(princ "\n(get_all_inters_in_SS) function and INTLINES command loaded.")
(prin1)

Alternatively, if anyone knows any alternative way to extract the x,y coordinates of a curve at specific intervals I would be so grateful to hear from you.

Kind regards,

ssredman

Are them lines and Splines already exist?

The splines and the vertical lines already exist.

I have placed the vertical lines so that i can pull out a sufficient number of data points. If there was an alternative method of pulling out the points then these lines would be unnecessary and would not be required to begin with.

Thanks.

Are the point entitiies placed on a given distance? or number of segments?

Anyhoo... Try this prompt for given distance.

(defun c:pntat (/ dist splines i e layer pts sp ep d)
 (if (and (setq dist (getdist "\nEnter Segment Distance: ")
	 ds   dist
   )
   (setq splines (ssget '((0 . "SPLINE"))))
     )
   (repeat (setq i (sslength splines))
     (setq e (ssname splines (setq i (1- i))))
     (setq layer (cdr (assoc 8 (entget e))))
     (setq pts	(list (vlax-curve-getStartPoint e)
	      (vlax-curve-getEndPoint e)
	)
     )
     (setq pts	(if (< (Caar pts) (caadr pts))
	  pts
	  (reverse pts)
	)
     )
     (setq sp (list (min (Caar pts) (caadr pts))
	     (setq y (min (cadar pts) (cadadr pts)))
	     0.0
       )
    ep (list (max (Caar pts) (caadr pts))
	     y
	     0.0
       )
    d  (distance sp ep)
     )
     (while (< dist d)
(entmakex
  (list	(cons 0 "POINT")
	(cons 8 layer)
	(cons 10
	      (vlax-curve-getClosestPointToProjection
		e
		(polar sp 0.0 dist)
		'(0 1 0)
	      )
	)
  )
)
(setq dist (+ dist ds))
     )
     (setq dist ds)
   )
 )
 (princ)
)

No mater where the startpoint of the spline. distance will always be from left to right

HTH

ssredman,

Do you really need your point at constant x distance?

If not look at "vlax-curve-getPointAtDist"

This would give you a list of 31 points on the curve:

(defun c:test ( )
  (if (setq en (car (entsel "\nSelect Polyline: ")))
     (progn
        (setq dtot (vlax-curve-getDistAtPoint en (vlax-curve-getEndPoint en))
              dist (/ dtot 30)
              pointlist nil
              cum 0
        )      
        (while (<= cum dtot)
            (setq pointlist (cons (vlax-curve-getPointAtDist en cum) pointlist)
                        cum (+ cum dist)
            )
        )  
     )
  )  
  (princ)
)  

ymg

Thankyou pBe, that worked perfectly.

Thankyou to ymg3 as well.

So, to find the point of the intersection between two lines or curves I must learn Lisp? There is no command in AutoCAD to do this job?

Thank you for the answer.

Hrcko,

Object snap to intersection or apparent intersection will do it

from the command line. One point at a time though.

ymg

Thank you ymg3, first I must find Apparent Intersection in the toolbar.

It is not in the toolbar but is an Osnap.

When in a command Right-click, a popup menu

will appear the you select apparent.

ymg

you can also set "osmode" to include apparent intersections.

you can also set "osmode" to include apparent intersections.

Thank you Snownut. I will do this in the morning. Here just passed midnight and I am going to the bed.

Kind regards,

Hrcko