Intresections along line/Pline

Intresections along line/Pline

John_nilsson6G97B
Participant Participant
1,605 Views
23 Replies
Message 1 of 24

Intresections along line/Pline

John_nilsson6G97B
Participant
Participant

Hello experts!
I found this lisp by Tharwat, that counts intersections between two points and it creates a table from the layer info.
 

John_nilsson6G97B_0-1736434603776.png

 


I need help to change it so instead of choosing two points I can select the line/pline and get all the intersections in one table for the whole length of the line. Also, if possible, ad at what length along the line/pline the intersection occurs. Would this be possible?

Here’s the code:
(defun c:Test (/ entities i number integer layers lst object point1 p

              height point2 result selectionset selectionsetname

              singlelayer model table r c inc

             )

 (vl-load-com)

 (if (and (setq point1 (getpoint "\n Specify first point :"))

          (setq point2 (getpoint point1 "\n Specify Second point :"))

          (setq selectionset

                 (ssget "_F"

                        (list point1 point2)

                        '((0 . "LINE,*POLYLINE"))

                 )

          )

 

          (setq p (getpoint "\n Table insertion point :"))

     )

   (progn

     (setq height (if (zerop (cdr (assoc 40

                                         (setq st

                                                (entget

                                                  (tblobjname "STYLE" (getvar 'textstyle))

                                                )

                                         )

                                  )

                             )

                      )

                    (cdr (assoc 42 st))

                    (cdr (assoc 40 st))

                  )

     )

     (repeat (setq integer (sslength selectionset))

       (setq entities (cons (setq selectionsetname

                                   (ssname

                                     selectionset

                                     (setq integer (1- integer))

                                   )

                            )

                            entities

                      )

       )

       (if (not (member (setq singlelayer

                               (cdr (assoc 8 (entget selectionsetname)))

                        )

                        layers

                )

           )

         (setq layers (cons singlelayer layers))

       )

     )

     (setq i 0)

     (foreach layer layers

       (repeat (setq number (length entities))

         (if

           (eq

             (cdr

               (assoc 8

                      (entget (nth (setq number (1- number)) entities))

               )

             )

             layer

           )

            (setq lst (cons layer (setq i (1+ i))))

         )

       )

       (setq result (cons lst result))

       (setq i 0)

     )

     (setq model (vla-get-modelspace

                   (vla-get-activedocument (vlax-get-acad-object))

                 )

     )

     (setq table (vla-addtable

                   model

                   (vlax-3d-point p)

                   (1+ (length result))

                   2

                   (* height 2.)

                   (* height 10.)

                 )

     )

     (vla-settext table 0 0 "Section A - B")

     (setq r   0

           c   0

           inc -1

     )

     (repeat (length result)

       (vla-settext

         table

         (setq r (1+ r))

         c

         (car (nth (setq inc (1+ inc)) result))

       )

       (vla-settext

         table

         r

         (setq c (1+ c))

         (itoa (cdr (nth inc result)))

       )

       (setq c 0)

     )

   )

 )

 (princ)

)

0 Likes
Accepted solutions (1)
1,606 Views
23 Replies
Replies (23)
Message 2 of 24

hosneyalaa
Advisor
Advisor

Can you attached example drawing 

Message 3 of 24

ronjonp
Mentor
Mentor

I think this should do it, but a sample drawing would definitely help.

 

(defun c:test (/ tracepline c e h o p pt pts r result s st table)
  ;; JB  4/1/2006
  ;; Arguments: obj - a heavy or lightweight pline ename or vla-object.
  ;;            deg - the approximate number of degrees between points
  ;;                  along an arc. Suggested value: 10.
  ;; Returns: WCS point list if successful.
  ;; Notes: The number of points returned when tracing an arc is proportional
  ;;        to the included angle.
  ;;        Duplicate adjacent points are removed.
  ;;        The last closing point is included given a closed pline.
  (defun tracepline (obj deg / typ param endparam pt blg ptlst delta inc arcparam)
    (and
      (or (= (type obj) 'vla-object) (setq obj (vlax-ename->vla-object obj)))
      (setq typ (vlax-get obj 'objectname))
      (or (= typ "AcDb2dPolyline") (= typ "AcDbPolyline"))
      (setq param    0
	    endparam (vlax-curve-getendparam obj)
      )
      (while (<= param endparam)
	(setq pt (vlax-curve-getpointatparam obj param))
					;Avoid duplicate points between start and end.
	(if (not (equal pt (car ptlst) 1e-12))
	  (setq ptlst (cons pt ptlst))
	)				;A closed pline returns an error (invalid index)
					;when asking for the bulge of the end param.
	(if (and (/= param endparam) (setq blg (abs (vlax-invoke obj 'getbulge param))) (/= 0 blg))
	  (progn (setq delta	(* 4 (atan blg)) ;included angle
		       inc	(/ 1.0 (1+ (fix (/ delta (* pi (/ deg 180.0))))))
		       arcparam	(+ param inc)
		 )
		 (while	(< arcparam (1+ param))
		   (setq pt	  (vlax-curve-getpointatparam obj arcparam)
			 ptlst	  (cons pt ptlst)
			 arcparam (+ inc arcparam)
		   )
		 )
	  )
	)
	(setq param (1+ param))
      )
    )					;and
    (if	(and (apply 'and ptlst) (> (length ptlst) 1))
      (reverse ptlst)
    )
  )					;end
  (if (and (setq e (car (entsel "\nPick polyline: ")))
	   (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
	   (setq o (vlax-ename->vla-object e))
	   (setq pts (tracepline e 10))
	   ;; RJP » Selection set minus polyline used for fence
	   (setq s (ssget "_F" pts '((0 . "LINE,*POLYLINE"))))
	   (ssdel e s)
	   (setq p (getpoint "\nTable insertion point :"))
      )
    (progn
      (ssdel e s)
      ;; RJP » 2025-01-13 Visual of trace density
      (mapcar '(lambda (r j) (grdraw r j 2)) pts (cdr pts))
      (setq h
	     (if (zerop (cdr (assoc 40 (setq st (entget (tblobjname "STYLE" (getvar 'textstyle)))))))
	       (cdr (assoc 42 st))
	       (cdr (assoc 40 st))
	     )
      )
      (foreach x (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex s)))
	(setq pts (vlax-invoke x 'intersectwith o acextendnone))
	;; Gather layer name, intersect point, distance from start
	(while (setq pt (mapcar '+ pts '(0 0 0)))
	  (setq result (cons (list (vla-get-layer x) pt (vlax-curve-getdistatpoint o pt)) result))
	  (setq pts (cdddr pts))
	)
      )
      ;; RJP » Sort by distance
      (setq result (vl-sort result '(lambda (r j) (< (caddr r) (caddr j)))))
      (setq result (append '(("LAYER" "POINT" "DISTANCE")) result))
      (setq table (vla-addtable
		    (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
		    (vlax-3d-point p)
		    (1+ (length result))
		    (length (car result))
		    (* h 2.)
		    (* h 10.)
		  )
      )
      (vla-settext table 0 0 "Intersection Stations")
      (setq r 0
	    c -1
      )
      (foreach x result
	(setq r (1+ r))
	(foreach x2 x (vla-settext table r (setq c (1+ c)) (vl-princ-to-string x2)))
	(setq c -1)
      )
    )
  )
  (princ)
)

 

 

 

 

Message 4 of 24

John_nilsson6G97B
Participant
Participant

10-4 loud & clear.
I have a lisp that marks the intersections.
I want a table that points to these crossings (like @ronjonp code) whith'in the length that they accure along the polyline and by layername like in the original code table.

 

John_nilsson6G97B_0-1736458345682.png

@ronjonpdang close chif.
If you can manage to seperate the table whithin the length of the line/pline sellected, then we are "golden" depending of the units sellected... in my case meters (often). 

0 Likes
Message 5 of 24

ronjonp
Mentor
Mentor
Accepted solution

@John_nilsson6G97B  Give this a try .. it outputs 'LAYER POINT DISTANCE'.

 

(defun c:test (/ tracepline c e h o p pt pts r result s st table)
  ;; JB  4/1/2006
  ;; Arguments: obj - a heavy or lightweight pline ename or vla-object.
  ;;            deg - the approximate number of degrees between points
  ;;                  along an arc. Suggested value: 10.
  ;; Returns: WCS point list if successful.
  ;; Notes: The number of points returned when tracing an arc is proportional
  ;;        to the included angle.
  ;;        Duplicate adjacent points are removed.
  ;;        The last closing point is included given a closed pline.
  (defun tracepline (obj deg / typ param endparam pt blg ptlst delta inc arcparam)
    (and
      (or (= (type obj) 'vla-object) (setq obj (vlax-ename->vla-object obj)))
      (setq typ (vlax-get obj 'objectname))
      (or (= typ "AcDb2dPolyline") (= typ "AcDbPolyline"))
      (setq param    0
	    endparam (vlax-curve-getendparam obj)
      )
      (while (<= param endparam)
	(setq pt (vlax-curve-getpointatparam obj param))
					;Avoid duplicate points between start and end.
	(if (not (equal pt (car ptlst) 1e-12))
	  (setq ptlst (cons pt ptlst))
	)				;A closed pline returns an error (invalid index)
					;when asking for the bulge of the end param.
	(if (and (/= param endparam) (setq blg (abs (vlax-invoke obj 'getbulge param))) (/= 0 blg))
	  (progn (setq delta	(* 4 (atan blg)) ;included angle
		       inc	(/ 1.0 (1+ (fix (/ delta (* pi (/ deg 180.0))))))
		       arcparam	(+ param inc)
		 )
		 (while	(< arcparam (1+ param))
		   (setq pt	  (vlax-curve-getpointatparam obj arcparam)
			 ptlst	  (cons pt ptlst)
			 arcparam (+ inc arcparam)
		   )
		 )
	  )
	)
	(setq param (1+ param))
      )
    )					;and
    (if	(and (apply 'and ptlst) (> (length ptlst) 1))
      (reverse ptlst)
    )
  )					;end
  (if (and (setq e (car (entsel "\nPick polyline: ")))
	   (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
	   (setq o (vlax-ename->vla-object e))
	   (setq pts (tracepline e 10))
	   ;; RJP » Selection set minus polyline used for fence
	   (setq s (ssget "_F" pts '((0 . "LINE,*POLYLINE"))))
	   (ssdel e s)
	   (setq p (getpoint "\nTable insertion point :"))
      )
    (progn
      (ssdel e s)
      ;; RJP » 2025-01-13 Visual of trace density
      (mapcar '(lambda (r j) (grdraw r j 2)) pts (cdr pts))
      (setq h
	     (if (zerop (cdr (assoc 40 (setq st (entget (tblobjname "STYLE" (getvar 'textstyle)))))))
	       (cdr (assoc 42 st))
	       (cdr (assoc 40 st))
	     )
      )
      (foreach x (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex s)))
	(setq pts (vlax-invoke x 'intersectwith o acextendnone))
	;; Gather layer name, intersect point, distance from start
	(while (setq pt (mapcar '+ pts '(0 0 0)))
	  (setq result (cons (list (vla-get-layer x) pt (vlax-curve-getdistatpoint o pt)) result))
	  (setq pts (cdddr pts))
	)
      )
      ;; RJP » Sort by distance
      (setq result (vl-sort result '(lambda (r j) (< (caddr r) (caddr j)))))
      (setq result (append '(("LAYER" "POINT" "DISTANCE")) result))
      (setq table (vla-addtable
		    (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
		    (vlax-3d-point p)
		    (1+ (length result))
		    (length (car result))
		    (* h 2.)
		    (* h 10.)
		  )
      )
      (vla-settext table 0 0 "Intersection Stations")
      (setq r 0
	    c -1
      )
      (foreach x result
	(setq r (1+ r))
	(foreach x2 x (vla-settext table r (setq c (1+ c)) (vl-princ-to-string x2)))
	(setq c -1)
      )
    )
  )
  (princ)
)

 

 

 

 

 

 

0 Likes
Message 6 of 24

Sea-Haven
Mentor
Mentor

@ronjonp has provided you with a great answer, but it would be good if you could provide a sample dwg with the desired table output, what it should look like with all values set text height, column widths etc. A table is like a dimension and has so many different settings not just text style and column widths. It is possible to make a table style as part of the code.

0 Likes
Message 7 of 24

John_nilsson6G97B
Participant
Participant

@ronjonpNow that's what I'm talking about! Thank you. Where can I donate? The first beer is on me. 🍺

 

@Sea-HavenI love that thougt. But I dont need anyting fancy. Just the points and what the intersection is. Ron got it. I'm happy and this will save me a lot of time.

 

Thank you guys!

0 Likes
Message 8 of 24

Kent1Cooper
Consultant
Consultant

[Maybe it won't matter in your case, but there's the potential for the age-old problem caused by arc segments in the Polyline.  If there are any, the Fence it selects by will not take them into account, but will go in straight-line Fence segments from vertex to vertex.  So it could catch some things that don't actually intersect the Polyline, and/or could miss some things that do.]

Kent Cooper, AIA
0 Likes
Message 9 of 24

Sea-Haven
Mentor
Mentor

Just following on about make table if you don't set the table style it will use say the single default table settings, so it may still be worth while making a table style that suits your needs and save in your DWT.

 

One quick way is to have a lisp that makes table styles, so in your code you can load as a sub routine that lisp code after checking does table style exist, if it does then don't load, so all that code is not in your master program. 

0 Likes
Message 10 of 24

John_nilsson6G97B
Participant
Participant

I think @Kent1Cooper is on to somthing here.
When I play around with the on that marks all intersections and the table count, the numbers dont add up. I get 225 marked intersections and only 156 in the table.
Is there a way to account for this Kent?

@Sea-HavenIn my case I will extract the info and put it in to Excel sheet with more info.

0 Likes
Message 11 of 24

Kent1Cooper
Consultant
Consultant

@John_nilsson6G97B wrote:

I think @Kent1Cooper is on to somthing here. .... the numbers dont add up. .... Is there a way to account for this...?


There are several threads about the problem of arc segments in Polylines throwing off the result of (ssget) using a Crossing window or Fence along the vertices.  I'll let you Search.  At least some suggestions involve not just taking a list of vertices, but of locations more closely spaced along the path of the Polyline, so that at least the Window/Fence path [still in straight-line segments] more closely follows the actual shape.

Kent Cooper, AIA
0 Likes
Message 12 of 24

ronjonp
Mentor
Mentor

@John_nilsson6G97B See if you can implement Lee's code HERE. One bug I've found is if there are too many points in the list ( I don't know the exact threshold ) the fence selection will fail. Also depending on your version of CAD make sure that the entire fence selection is on screen.

0 Likes
Message 13 of 24

John_nilsson6G97B
Participant
Participant

Oh @ronjonp, we passed my coding skills a long time ago with this. 😅
Thats why I turned to the experts with my dilema. But I understand the difficulty that this brings. And makes it understandebl why the lisp I found only counted the intersections between to points.

0 Likes
Message 14 of 24

ronjonp
Mentor
Mentor

@John_nilsson6G97B wrote:

Oh @ronjonp, we passed my coding skills a long time ago with this. 😅
Thats why I turned to the experts with my dilema. But I understand the difficulty that this brings. And makes it understandebl why the lisp I found only counted the intersections between to points.


😂 No worries it's not that hard of a problem to solve. There is another solution by Joe Burke which I linked to HERE a coupe of years ago. Unfortunately this thread has been archived ... bad decision on Autodesk forum moderators part IMO but I don't make the rules.

 

Since this information is not available anymore  here ( at least at my link ) I'm going to post it again in this thread to keep it alive until it gets archived again 🙄.

;; JB  4/1/2006
;; Arguments: obj - a heavy or lightweight pline ename or vla-object.
;;            deg - the approximate number of degrees between points
;;                  along an arc. Suggested value: 10.
;; Returns: WCS point list if successful.
;; Notes: The number of points returned when tracing an arc is proportional
;;        to the included angle.
;;        Duplicate adjacent points are removed.
;;        The last closing point is included given a closed pline.

(defun tracepline (obj deg / typ param endparam pt blg ptlst delta inc arcparam)
  (and (or (= (type obj) 'vla-object) (setq obj (vlax-ename->vla-object obj)))
       (setq typ (vlax-get obj 'objectname))
       (or (= typ "AcDb2dPolyline") (= typ "AcDbPolyline"))
       (setq param    0
	     endparam (vlax-curve-getendparam obj)
       )
       (while (<= param endparam)
	 (setq pt (vlax-curve-getpointatparam obj param))
					;Avoid duplicate points between start and end.
	 (if (not (equal pt (car ptlst) 1e-12))
	   (setq ptlst (cons pt ptlst))
	 )				;A closed pline returns an error (invalid index)
					;when asking for the bulge of the end param.
	 (if (and (/= param endparam) (setq blg (abs (vlax-invoke obj 'getbulge param))) (/= 0 blg))
	   (progn (setq	delta	 (* 4 (atan blg)) ;included angle
			inc	 (/ 1.0 (1+ (fix (/ delta (* pi (/ deg 180.0))))))
			arcparam (+ param inc)
		  )
		  (while (< arcparam (1+ param))
		    (setq pt	   (vlax-curve-getpointatparam obj arcparam)
			  ptlst	   (cons pt ptlst)
			  arcparam (+ inc arcparam)
		    )
		  )
	   )
	 )
	 (setq param (1+ param))
       )
  )					;and
  (if (and (apply 'and ptlst) (> (length ptlst) 1))
    (reverse ptlst)
  )
)					;end

 

I've updated the code above to use this function so it should work on arc segments now.

 

 

0 Likes
Message 15 of 24

John_nilsson6G97B
Participant
Participant

@ronjonpI get "Pick polyline: error: bad argument type: lselsetp nil". 🤔

0 Likes
Message 16 of 24

ronjonp
Mentor
Mentor

@John_nilsson6G97B Strange it works fine here?

0 Likes
Message 17 of 24

John_nilsson6G97B
Participant
Participant

@ronjonp 
Super odd, I even restarted my computor. Still the same error. Changed the pline to another version if it hade something to do with that. Still same result. 🤔

0 Likes
Message 18 of 24

ronjonp
Mentor
Mentor

Post the drawing you're using.

0 Likes
Message 19 of 24

John_nilsson6G97B
Participant
Participant

Here goes. 😁

0 Likes
Message 20 of 24

ronjonp
Mentor
Mentor

That error occurs because nothing gets selected. I've changed the code above to not error. It might be the anomaly I mentioned earlier where the point list is too long or there are duplicate points in the list that cause the fence selection to fail. 

0 Likes