Jump to content

Help create points and get numbering at the intersection of line, polyline

Silver2022

By Silver2022
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Silver2022 Newbie

Silver2022

Posted
Posted

Hi all. I need create points and get numbering at the intersection positions of line, polyline; and vertex polyline.
Can you help me create lisp?
If you can help me export the number information to excel (include number, x coordinate, y coordinate), that would be great.

 test.png

test.dwg

Silver2022 Newbie

Silver2022

Posted
  • Author
Posted

If have Autolisp, work will be faster. 

BIGAL Grand Master

BIGAL

Posted
Posted

Using lisp draw a snake ie a pline crossing verticals near end, then can get closest point to and number. Is this ok method ? If you want just do it then sorry no code.

 

image.thumb.png.edc3940f76cd14cd922bb249f9c9927d.png

hosneyalaa Community Regular

hosneyalaa

Posted
Posted

try

  

; q_|_|| _\|| q_|| _\|


;;;(SETQ objPline objSelection)
(defun GetVerticies (objPline / intParam lstVerticies)
  (repeat (1+ (setq intParam (fix (vlax-curve-getendparam objPline))))
    (setq lstVerticies (cons (vlax-curve-getpointatparam objPline (float intParam)) lstVerticies))
    (setq intParam (1- intParam))
    )
  lstVerticies
  )

;;; Tharwat 15. Feb. 2013 ;;;
(defun _Mid (p1 p2)
  (mapcar '(lambda (j k) (/ (+ j k) 2.)) p1 p2)
  )
;;;(SETQ lstVerticies lstReturnXY)
(defun GetSegments (lstVerticies)
  (mapcar '(lambda (X Y) (- (if (eq Y (last lstVerticies)) (vlax-curve-getdistatparam objSelection (vlax-curve-getendparam objSelection)) (vlax-curve-getdistatpoint objSelection Y)) (vlax-curve-getdistatpoint objSelection X)))
	  (reverse (cdr (reverse lstVerticies)))
	  (cdr lstVerticies)
	  )
  )



(defun GetAngles (lstVerticies)
  (mapcar '(lambda (X Y) (* 180 (/ (angle X Y) pi)))
	  (reverse (cdr (reverse lstVerticies)))
	  (cdr lstVerticies)
	  )
  )


(defun AREA1(e) (vlax-curve-getarea e ))


(defun LM:lst->str ( lst del / str )
  (setq str (car lst))
  (foreach itm (cdr lst) (setq str (strcat str del itm)))
  str
  )



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; by GP_   https://forums.autodesk.com/t5/autocad-portugues/identificar-texto-dentro-de-um-poligono-polyline-fechada/td-p/7138674
;; http://www.cadtutor.net/forum/showthread.php?84483-Check-if-a-point-is-inside-an-area-bounded-by-a-polyline&p=578928&viewfull=1#post578928
(defun inside_p (list_vert :p / out_p cross on)
  (setq out_p (list (car (getvar "extmax")) (* 1.1 (cadr (getvar "extmax")))))
  (setq cross 0)
  (mapcar
    '(lambda (a b)
       (if (or
	     (equal (angle a :p) (angle :p b) 1e-8)
	     (equal a :p 1e-8)
	     )
	 (setq on t)
	 )
       (if (setq :p: (inters :p out_p a b))
	 (setq cross (1+ cross))
	 )
       )
    list_vert
    (cdr list_vert)
    )
  (cond
    (on "ON")
    ((> (rem cross 2) 0) "INSIDE")
    (t "OUTSIDE")
    )
  )


(defun vk_IsPointInside (Point PointsList / PY P1Y P2Y)
  ; works with polygons only, i.e. if (equal (car PointsList) (last PointsList))
  (if (cdr PointsList)
    (/=    (and (or (and (<= (setq    PY  (cadr Point)
				      P2Y (cadadr PointsList)
				      P1Y (cadar PointsList)
				      )
			     PY
			     )
			 (< PY P2Y)
			 )
		    (and (> P1Y PY) (>= PY P2Y))
		    )
		(>    (car Point)
		      (+ (* (/ (- PY P1Y) (- P2Y P1Y))
			    (- (caadr PointsList) (caar PointsList))
			    )
			 (caar PointsList)
			 )
		      )
		)
	   (vk_IsPointInside Point (cdr PointsList))
	   )
    )
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; http://www.theswamp.org/index.php?topic=18725
(defun vl-pline-centroid (pl / AcDoc Space obj reg cen)
  (vl-load-com)
  (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
	Space (if (= (getvar "CVPORT") 1)
		(vla-get-PaperSpace AcDoc)
		(vla-get-ModelSpace AcDoc)
		)
	)
  (or (= (type pl) 'VLA-OBJECT)
      (setq obj (vlax-ename->vla-object pl))
      )
  (setq reg (vlax-invoke Space 'addRegion (list obj))
	cen (vlax-get (car reg) 'Centroid)
	)
  (vla-delete (car reg))
  (trans cen 1 (vlax-get obj 'Normal))
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun C:TEST (/ EEE FUZZ IIP IIPT INTP LSSPO LST NT NUMBLIST OBJPP PSELECTIONS PTLST SSTEXT STRN X)
  (vl-load-com)
  
  
  
  
  
  (princ "\nSelect lines: ")
  (princ "\nSelect lines: ")
  (setq sstext(ssget  '((0 . "line"))))   ;(ssget "X" '((0 . "text")))
  (setq ptLst(mapcar '(lambda(x)(list (_Mid(cdr(assoc 10 x))(cdr(assoc 11 x))) (cdr(assoc 10 x)) (cdr(assoc 11 x))  )) (mapcar 'entget(vl-remove-if 'listp(mapcar 'cadr(ssnamex sstext))))))
  
   (princ "\nSelect POLYLINE: ")
  (princ "\nSelect POLYLINE: ")
  (if  (setq pSelections (ssget   (list '(0 . "LWPOLYLINE,POLYLINE") '(70 . 1))))   ;(ssget "_X" (list '(0 . "LWPOLYLINE,POLYLINE") '(70 . 1)))
    
    (progn
      
      (setq IiPt 0)
      (setq intp -1)
      
      (setq nt nil)
      (repeat (sslength pSelections)
	
	
	(setq intp     (1+ intp))
	(setq  objpp (vlax-ename->vla-object (setq eee(ssname pSelections intp))))
	
	
	(setq lst (getverticies objpp));coord  (245.237,149.595 0.0)
	(setq nt (append (cdr lst) nt))
	
	(if (not (equal (car lst) (last lst)))
	  (setq lst (cons (last lst) lst))
	  )
	
	(setq IiP 0)
	
	
	
	(if ptLst
	  (progn
	    (REPEAT (LENGTH ptLst)
	      
	      
	      (if (AND
		    (= T (vk_IsPointInside (car(nth IiP ptLst)) lst))
		    (/= (inside_p lst (car(nth IiP ptLst))) "OUTSIDE")
		    )
		(progn
		  (setq numblist (cons (car(cdr(nth IiP ptLst)))numblist))
		  (setq numblist (cons (cadr(cdr(nth IiP ptLst)))numblist))
		  ;(setq numblist nil)
		  );; (progn
		
		);;	(if
	      
	      
	      (setq IiP(+ 1 IiP))
	      );;;REPEAT
	    ))

	
        
	(setq nt (append numblist nt))
	
	(setq numblist nil)

)


      
 (setq fuzz 0.001) ;; comparison precision
	    (defun compare-points (a b)
	      (if (equal (cadr a) (cadr b) fuzz)
		  (< (car a) (car b))
		  (> (cadr a) (cadr b))
		
		)
	      )
	   



      
      (setq nt(vl-sort nt 'compare-points))
	(setq IiP -1)
	(REPEAT (LENGTH nt)

	  
	      (setq IiP (+ 1 IiP))

	  
	      
	      (if (nth  IiP  nt)
		(progn

		  (setq IiPt(+ 1 IiPt))

		  (setq Lsspo
			 (entmakex (list (cons 0 "TEXT")
	                  (cons 10  (nth  IiP  nt))
		          (cons 11  (nth  IiP  nt))
			  (cons 8 "T1")
	                  (cons 40 0.6)
			  (cons 62 1)
			  (cons 72 0)
			  (cons 73 4)
			  (cons 50 0) 
	                  (cons 1 (RTOS IiPt 2 0 ))
					 )
				   )
			)

		  

		  );; (progn
		
		);;	(if
	      
	      
	      
	      )

              (setq nt nil)
	

	) ;;; repeat




      )

  )


; q_|_|| _\|| q_|| _\|

; q_|_|| _\|| q_|| _\|






; q_|_|| _\|| q_|| _\|
; q_|_|| _\|| q_|| _\|
; q_|_|| _\|| q_|| _\|










; q_|_|| _\|| q_|| _\|
; q_|_|| _\|| q_|| _\|
; q_|_|| _\|| q_|| _\|

 

 

 

 

Capture.JPG

  • Thanks 1
  • 2 years later...
vitor Newbie

vitor

Posted
Posted

Hi, @hosneyalaa! 😀

 

Could you help me with your code? I'm trying to run it on AutoCAD 2024, but it seems to not be working as it should be. It won't let me select the polyline in the first prompt and doesn't recognize it:

 

image.png.88dcba4cae6c8e3e34bf62b11307d588.png

image.png.2cc52bbe89187cc0b0e4a72227794f75.png

 

Thanks in advance!!

 

On 11/30/2021 at 5:00 AM, hosneyalaa said:

try

  

; q_|_|| _\|| q_|| _\|


;;;(SETQ objPline objSelection)
(defun GetVerticies (objPline / intParam lstVerticies)
  (repeat (1+ (setq intParam (fix (vlax-curve-getendparam objPline))))
    (setq lstVerticies (cons (vlax-curve-getpointatparam objPline (float intParam)) lstVerticies))
    (setq intParam (1- intParam))
    )
  lstVerticies
  )

;;; Tharwat 15. Feb. 2013 ;;;
(defun _Mid (p1 p2)
  (mapcar '(lambda (j k) (/ (+ j k) 2.)) p1 p2)
  )
;;;(SETQ lstVerticies lstReturnXY)
(defun GetSegments (lstVerticies)
  (mapcar '(lambda (X Y) (- (if (eq Y (last lstVerticies)) (vlax-curve-getdistatparam objSelection (vlax-curve-getendparam objSelection)) (vlax-curve-getdistatpoint objSelection Y)) (vlax-curve-getdistatpoint objSelection X)))
	  (reverse (cdr (reverse lstVerticies)))
	  (cdr lstVerticies)
	  )
  )



(defun GetAngles (lstVerticies)
  (mapcar '(lambda (X Y) (* 180 (/ (angle X Y) pi)))
	  (reverse (cdr (reverse lstVerticies)))
	  (cdr lstVerticies)
	  )
  )


(defun AREA1(e) (vlax-curve-getarea e ))


(defun LM:lst->str ( lst del / str )
  (setq str (car lst))
  (foreach itm (cdr lst) (setq str (strcat str del itm)))
  str
  )



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; by GP_   https://forums.autodesk.com/t5/autocad-portugues/identificar-texto-dentro-de-um-poligono-polyline-fechada/td-p/7138674
;; http://www.cadtutor.net/forum/showthread.php?84483-Check-if-a-point-is-inside-an-area-bounded-by-a-polyline&p=578928&viewfull=1#post578928
(defun inside_p (list_vert :p / out_p cross on)
  (setq out_p (list (car (getvar "extmax")) (* 1.1 (cadr (getvar "extmax")))))
  (setq cross 0)
  (mapcar
    '(lambda (a b)
       (if (or
	     (equal (angle a :p) (angle :p b) 1e-8)
	     (equal a :p 1e-8)
	     )
	 (setq on t)
	 )
       (if (setq :p: (inters :p out_p a b))
	 (setq cross (1+ cross))
	 )
       )
    list_vert
    (cdr list_vert)
    )
  (cond
    (on "ON")
    ((> (rem cross 2) 0) "INSIDE")
    (t "OUTSIDE")
    )
  )


(defun vk_IsPointInside (Point PointsList / PY P1Y P2Y)
  ; works with polygons only, i.e. if (equal (car PointsList) (last PointsList))
  (if (cdr PointsList)
    (/=    (and (or (and (<= (setq    PY  (cadr Point)
				      P2Y (cadadr PointsList)
				      P1Y (cadar PointsList)
				      )
			     PY
			     )
			 (< PY P2Y)
			 )
		    (and (> P1Y PY) (>= PY P2Y))
		    )
		(>    (car Point)
		      (+ (* (/ (- PY P1Y) (- P2Y P1Y))
			    (- (caadr PointsList) (caar PointsList))
			    )
			 (caar PointsList)
			 )
		      )
		)
	   (vk_IsPointInside Point (cdr PointsList))
	   )
    )
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; http://www.theswamp.org/index.php?topic=18725
(defun vl-pline-centroid (pl / AcDoc Space obj reg cen)
  (vl-load-com)
  (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
	Space (if (= (getvar "CVPORT") 1)
		(vla-get-PaperSpace AcDoc)
		(vla-get-ModelSpace AcDoc)
		)
	)
  (or (= (type pl) 'VLA-OBJECT)
      (setq obj (vlax-ename->vla-object pl))
      )
  (setq reg (vlax-invoke Space 'addRegion (list obj))
	cen (vlax-get (car reg) 'Centroid)
	)
  (vla-delete (car reg))
  (trans cen 1 (vlax-get obj 'Normal))
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun C:TEST (/ EEE FUZZ IIP IIPT INTP LSSPO LST NT NUMBLIST OBJPP PSELECTIONS PTLST SSTEXT STRN X)
  (vl-load-com)
  
  
  
  
  
  (princ "\nSelect lines: ")
  (princ "\nSelect lines: ")
  (setq sstext(ssget  '((0 . "line"))))   ;(ssget "X" '((0 . "text")))
  (setq ptLst(mapcar '(lambda(x)(list (_Mid(cdr(assoc 10 x))(cdr(assoc 11 x))) (cdr(assoc 10 x)) (cdr(assoc 11 x))  )) (mapcar 'entget(vl-remove-if 'listp(mapcar 'cadr(ssnamex sstext))))))
  
   (princ "\nSelect POLYLINE: ")
  (princ "\nSelect POLYLINE: ")
  (if  (setq pSelections (ssget   (list '(0 . "LWPOLYLINE,POLYLINE") '(70 . 1))))   ;(ssget "_X" (list '(0 . "LWPOLYLINE,POLYLINE") '(70 . 1)))
    
    (progn
      
      (setq IiPt 0)
      (setq intp -1)
      
      (setq nt nil)
      (repeat (sslength pSelections)
	
	
	(setq intp     (1+ intp))
	(setq  objpp (vlax-ename->vla-object (setq eee(ssname pSelections intp))))
	
	
	(setq lst (getverticies objpp));coord  (245.237,149.595 0.0)
	(setq nt (append (cdr lst) nt))
	
	(if (not (equal (car lst) (last lst)))
	  (setq lst (cons (last lst) lst))
	  )
	
	(setq IiP 0)
	
	
	
	(if ptLst
	  (progn
	    (REPEAT (LENGTH ptLst)
	      
	      
	      (if (AND
		    (= T (vk_IsPointInside (car(nth IiP ptLst)) lst))
		    (/= (inside_p lst (car(nth IiP ptLst))) "OUTSIDE")
		    )
		(progn
		  (setq numblist (cons (car(cdr(nth IiP ptLst)))numblist))
		  (setq numblist (cons (cadr(cdr(nth IiP ptLst)))numblist))
		  ;(setq numblist nil)
		  );; (progn
		
		);;	(if
	      
	      
	      (setq IiP(+ 1 IiP))
	      );;;REPEAT
	    ))

	
        
	(setq nt (append numblist nt))
	
	(setq numblist nil)

)


      
 (setq fuzz 0.001) ;; comparison precision
	    (defun compare-points (a b)
	      (if (equal (cadr a) (cadr b) fuzz)
		  (< (car a) (car b))
		  (> (cadr a) (cadr b))
		
		)
	      )
	   



      
      (setq nt(vl-sort nt 'compare-points))
	(setq IiP -1)
	(REPEAT (LENGTH nt)

	  
	      (setq IiP (+ 1 IiP))

	  
	      
	      (if (nth  IiP  nt)
		(progn

		  (setq IiPt(+ 1 IiPt))

		  (setq Lsspo
			 (entmakex (list (cons 0 "TEXT")
	                  (cons 10  (nth  IiP  nt))
		          (cons 11  (nth  IiP  nt))
			  (cons 8 "T1")
	                  (cons 40 0.6)
			  (cons 62 1)
			  (cons 72 0)
			  (cons 73 4)
			  (cons 50 0) 
	                  (cons 1 (RTOS IiPt 2 0 ))
					 )
				   )
			)

		  

		  );; (progn
		
		);;	(if
	      
	      
	      
	      )

              (setq nt nil)
	

	) ;;; repeat




      )

  )


; q_|_|| _\|| q_|| _\|

; q_|_|| _\|| q_|| _\|






; q_|_|| _\|| q_|| _\|
; q_|_|| _\|| q_|| _\|
; q_|_|| _\|| q_|| _\|










; q_|_|| _\|| q_|| _\|
; q_|_|| _\|| q_|| _\|
; q_|_|| _\|| q_|| _\|

 

 

 

 

Capture.JPG

 

hosneyalaa Community Regular

hosneyalaa

Posted
Posted

Can you attached example drawing 

vitor Newbie

vitor

Posted
Posted
On 2/2/2024 at 1:36 PM, hosneyalaa said:

Can you attached example drawing 

I tested with just a simple polyline. Can you test if it still working? I'm on AutoCAD 2024..

Drawing1.dwg

  • 2 months later...
vitor Newbie

vitor

Posted
Posted
On 4/5/2024 at 2:50 PM, XDSoft said:

https://www.theswamp.org/index.php?topic=59423.0

Thanks for the reply, however, I needed to create a spreadsheet with coordinates, together with the numbering.

Also, the code returned an error:

 

"Command: XDTB_PLNUMBER
; error: no function definition: XD::VAR:GETDOUBLE"

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...