Jump to content

Recommended Posts

Posted

I found a lisp that does this, but i need a couple more tweaks to make this perfect. I need precision to be set to 2 decimal points and i also dont want Elevation output. Can someone help me change the nesecary lines, since i dont know the first thing about programming

 

Quote

;POLYVERT - list coordinates of polyline vertices
;
;CAD Studio - www.cadstudio.cz  www.cadforum.cz
;
(setq __PV_Delimiter "      ") ; or ";" or (chr 9)
(setq __PV_DP (getvar "LUPREC")) ; decimal places

(defun C:POLYVERT ( / ent listCOORDINATES PT1)
 (setq ent (entsel "\nPick POLYLINE to list vertices:"))
 (if
  (and ent
      (wcmatch (cdr (assoc 0 (entget (setq ent (car ent))))) "*POLYLINE") ;all types
  ) ;and
  (progn
   (setq listCOORDINATES (PolyVert ent)) ;make list
   (princ "\nVertex list:")
   (foreach PT1 listCOORDINATES ;all vertices
    (princ (strcat "\n" (rtos (car PT1) 2 __PV_DP) __PV_Delimiter
                        (rtos (cadr PT1) 2 __PV_DP)
__PV_Delimiter
                        (rtos (caddr PT1) 2 __PV_DP) )) ;
display XYZ
   ) ;for
  ) ;progn
  (princ " no polyline selected")
 ) ;if
 (princ)
)

; PolyVert
; returns vertices list for any type of polyline (in WCS coordinates)
; arg POLY: polyline to list (ename or vla-object)

(defun PolyVert (POLY / par pt1 lst)
  (vl-load-com)
  (setq    par (if (vlax-curve-isClosed POLY)
                (vlax-curve-getEndParam POLY) ; else
                (1+ (vlax-curve-getEndParam POLY))
            )
  )
  (while (setq pt1 (vlax-curve-getPointAtParam POLY (setq par (- par 1))))
   (setq lst (cons pt1 lst))
  )
) ; return lst

(princ "\nPOLYVERT command loaded.")
(princ)

 

Source:

https://www.cadstudio.cz/en/download.asp?file=PolyVert

Posted

To change the number of decimal places, change line 6. It says

(setq __PV_DP (getvar "LUPREC")) ; decimal places

Remove the part that says (getvar "LUPREC") and replace it with (or however many). You can also keep this line and change the precision with the UNITS command, which is where the routine gets this number.

 

To remove the Z coordinate, remove the text (lines 19 and 20) that says

__PV_Delimiter
                        (rtos (caddr PT1) 2 __PV_DP)

Make sure you keep the two parentheses at the end of the second line. You will get an error if they are missing.

  • Like 1
Posted (edited)

For me the code is a bit messy it  looks like old code. There are some simple ways to get the co-ordinates or just a vl 'getcoordinates. You could do multiple plines in one go checking for 3d polylines hence Z. Using ssget with pline filter would be way better than using entsel.

 

The reason no code is I would suggest a bit of a Google there is lots of examples out there and do decimals using rtos a better method than luprec.

 

For me I don't have anything pre done maybe Lee-mac.com has a good routine and I expect lots more.

 

If you paste these two lines 1 at a time you will see the co-ords.

 


(setq ent (entsel))
(if ent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent))))))

 

 

Edited by BIGAL
Posted
19 hours ago, CyberAngel said:

To change the number of decimal places, change line 6. It says

(setq __PV_DP (getvar "LUPREC")) ; decimal places

Remove the part that says (getvar "LUPREC") and replace it with (or however many). You can also keep this line and change the precision with the UNITS command, which is where the routine gets this number.

 

To remove the Z coordinate, remove the text (lines 19 and 20) that says

__PV_Delimiter
                        (rtos (caddr PT1) 2 __PV_DP)

Make sure you keep the two parentheses at the end of the second line. You will get an error if they are missing.

 

Thanx man worked like a charm

 

33 minutes ago, BIGAL said:

For me the code is a bit messy it  looks like old code. There are some simple ways to get the co-ordinates or just a vl 'getcoordinates. You could do multiple plines in one go checking for 3d polylines hence Z. Using ssget with pline filter would be way better than using entsel.

 

The reason no code is I would suggest a bit of a Google there is lots of examples out there and do decimals using rtos a better method than luprec.

 

For me I don't have anything pre done maybe Lee-mac.com has a good routine and I expect lots more.

 

If you paste these two lines 1 at a time you will see the co-ords.

 


(setq ent (entsel))
(if ent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent))))))

 

 

 

Not sure how the code could get any better, but with the cyberangels edits, it acts exactly as i wanted.

 

Is there any way to list lengths of each polyline side in a 3rd column (where z columkn used to be) ? This would get me to maximum effect since i'm required to have a table with vertex coordinates and its side for boundary polygons. And for the moment after i use this routine i do an autoannotate and then type each side manually. It would save me some time. Especially when the polygon changes shape and i have to redraw the table of information

 

 

Posted

Found code for the lengths as well. I only need the decimal precision to be set to "2", and the result to be added as the 3rd column on the prvious code without printint "Segment#:"

 

Quote

(defun c:Test (/ T_Entity T_Object T_Start T_End T_SegmentLengths T_Count)
   (if
      (and
         (setq T_Entity (car (entsel "\nSelect polyline: ")))
         (= (vla-get-ObjectName (setq T_Object (vlax-ename->vla-object T_Entity))) "AcDbPolyline")
      )
      (progn
         (setq T_Start (vlax-curve-getStartParam T_Object))
         (setq T_End   (vlax-curve-getEndParam T_Object))
         (while (< T_Start T_End)
            (setq T_SegmentLengths (append T_SegmentLengths (list (- (vlax-curve-getDistAtParam T_Object (setq T_Start (1+ T_Start))) (vlax-curve-getDistAtParam T_Object (1- T_Start))))))
         )
         (setq T_Count 0)
         (foreach T_Item T_SegmentLengths
            (princ (strcat "\nSegment " (itoa (setq T_Count (1+ T_Count))) ": " ))
         )         
         (princ (strcat "\n\n ** Total polyline length is " ))
      )
      (princ "\n ** Nothing selected or not a polyline.")
   )

 

 

Source:

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/list-the-length-of-all-segments-of-a-polyline/td-p/7506972

Posted

Vla-get-length is the answer.

 

It seemed a lot of code to do something simple there are lots of ways of getting co-ordinates of either 3d or 2d polylines.

 

If you look at lee-mac.com he has a great dump all info including arcs in a poly line.

 


(defun c:test ( , ent str pt str)
(setq ent (entsel))
(if ent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent))))))
(setq str "")
(repeat (setq x (length co-ord))
(setq pt (nth (setq x (- x 1)) co-ord))
(setq str  (strcat str "\n" "x= " (rtos (car pt) 2 3) " Y= " (rtos (cadr pt) 2 3)))
)
(alert str)
)

 

Please count lines of code. yes can add trans to world ucs.

 

 

Posted (edited)

My $0.05

 

(defun c:test ( / ent str pt str)
(setq ent (entsel))
(setq obj (vlax-ename->vla-object (car ent)))
(if (= (vla-get-objectname obj) "AcDbPolyline")
(progn
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent)))))
(setq str "")
(repeat (setq x (length co-ord))
(setq pt (nth (setq x (- x 1)) co-ord))
(setq str  (strcat str "\n" "x= " (rtos (car pt) 2 3) " Y= " (rtos (cadr pt) 2 3)))
)
(setq len (rtos (vla-get-length obj) 2 2))
(setq str (strcat str "\n \nLength = " len))
(alert str)
)
(alert "You did not pick pline")
)
)
(c:test)
Edited by BIGAL
Posted
31 minutes ago, BIGAL said:

My $0.05

 

 


(defun c:test ( / ent str pt str)
(setq ent (entsel))
(setq obj (vlax-ename->vla-object (car ent)))
(if (= (vla-get-objectname obj) "AcDbPolyline")
(progn
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent)))))
(setq str "")
(repeat (setq x (length co-ord))
(setq pt (nth (setq x (- x 1)) co-ord))
(setq str  (strcat str "\n" "x= " (rtos (car pt) 2 3) " Y= " (rtos (cadr pt) 2 3)))
)
)
(setq len (rtos (vla-get-length obj) 2 2))
(setq str (strcat str "\n \nLength = " len))
(alert str)
)
)
(c:test)


 

 

Does not load for me

 

Command: APPLOAD
test.lsp successfully loaded.
Command: syntax error :error#2

Posted

I added a "did not pick pline" but was working sometimes cutting and pasting hidden characters get added.

 

 

Posted

Thank you so much for your trouble BIGAL, sadly its pretty far from what i want. I'll just keep using the couple previous routines, and do a 2-step process.

Posted

The following outputs only the x and y followed by the distance from the previous point all with 2 decimal points.  I think that is what you wanted.

 

;POLYVERT - list coordinates of polyline vertices
;
;CAD Studio - www.cadstudio.cz  www.cadforum.cz
;
(setq __PV_Delimiter "      ")		; or ";" or (chr 9)
(setq __PV_DP (getvar "LUPREC"))	; decimal places
(command "-units" "" 2 "" "" "" "")
(defun C:POLYVERT (/ ent listCOORDINATES PT1)
  (setq ent (entsel "\nPick POLYLINE to list vertices:"))
  (if
    (and ent
	 (wcmatch (cdr (assoc 0 (entget (setq ent (car ent)))))
		  "*POLYLINE"
	 )				;all types
    )					;and
     (progn
       (setq listCOORDINATES (PolyVert ent)) ;make list
       (princ "\nVertex list (x y distance-from-previuos):")

       (setq pt0 (nth 0 listCOORDINATES))
       (foreach	PT1 listCOORDINATES	;all vertices
	 (setq d (distance pt0 pt1))
	 (princ	(strcat	"\n"
			(rtos (car PT1) 2 __PV_DP)
			__PV_Delimiter
			(rtos (cadr PT1) 2 __PV_DP)
			__PV_Delimiter
			(rtos d 2 __PV_DP)
			__PV_Delimiter
		)
	 )
	 display
	 XYZ
	 (setq pt0 pt1)
       )				;for
     )					;progn
     (princ " no polyline selected")
  )					;if
  (princ)
)


; PolyVert
; returns vertices list for any type of polyline (in WCS coordinates)
; arg POLY: polyline to list (ename or vla-object)

(defun PolyVert	(POLY / par pt1 lst)
  (vl-load-com)
  (setq	par (if	(vlax-curve-isClosed POLY)
	      (vlax-curve-getEndParam POLY) ; else
	      (1+ (vlax-curve-getEndParam POLY))
	    )
  )
  (while (setq pt1 (vlax-curve-getPointAtParam POLY (setq par (- par 1))))
    (setq lst (cons pt1 lst))
  )
)					; return lst

(princ "\nPOLYVERT command loaded.")
(princ)

 

  • Like 1
  • 2 weeks later...
Posted
On 6/15/2019 at 5:08 AM, lrm said:

The following outputs only the x and y followed by the distance from the previous point all with 2 decimal points.  I think that is what you wanted.

 


;POLYVERT - list coordinates of polyline vertices
;
;CAD Studio - www.cadstudio.cz  www.cadforum.cz
;
(setq __PV_Delimiter "      ")		; or ";" or (chr 9)
(setq __PV_DP (getvar "LUPREC"))	; decimal places
(command "-units" "" 2 "" "" "" "")
(defun C:POLYVERT (/ ent listCOORDINATES PT1)
  (setq ent (entsel "\nPick POLYLINE to list vertices:"))
  (if
    (and ent
	 (wcmatch (cdr (assoc 0 (entget (setq ent (car ent)))))
		  "*POLYLINE"
	 )				;all types
    )					;and
     (progn
       (setq listCOORDINATES (PolyVert ent)) ;make list
       (princ "\nVertex list (x y distance-from-previuos):")

       (setq pt0 (nth 0 listCOORDINATES))
       (foreach	PT1 listCOORDINATES	;all vertices
	 (setq d (distance pt0 pt1))
	 (princ	(strcat	"\n"
			(rtos (car PT1) 2 __PV_DP)
			__PV_Delimiter
			(rtos (cadr PT1) 2 __PV_DP)
			__PV_Delimiter
			(rtos d 2 __PV_DP)
			__PV_Delimiter
		)
	 )
	 display
	 XYZ
	 (setq pt0 pt1)
       )				;for
     )					;progn
     (princ " no polyline selected")
  )					;if
  (princ)
)


; PolyVert
; returns vertices list for any type of polyline (in WCS coordinates)
; arg POLY: polyline to list (ename or vla-object)

(defun PolyVert	(POLY / par pt1 lst)
  (vl-load-com)
  (setq	par (if	(vlax-curve-isClosed POLY)
	      (vlax-curve-getEndParam POLY) ; else
	      (1+ (vlax-curve-getEndParam POLY))
	    )
  )
  (while (setq pt1 (vlax-curve-getPointAtParam POLY (setq par (- par 1))))
    (setq lst (cons pt1 lst))
  )
)					; return lst

(princ "\nPOLYVERT command loaded.")
(princ)

 

 

 

 

Sorry Man i just saw this, i came back here randomly to check someething and just saw your port. This is exacly what i wanted. Just one last tweak. Is it possible that on the length column it starts length from point 1? Cause right now it calculates length 1 as 0.000 and Since it sees no secondary vertex on first point, and i get a 0 as my first length.

 

For instance i get

 

3195.18      2015.72      0.00
3212.68      1845.18      171.44
3361.47      1845.18      148.79
3361.47      1945.75      100.58
3195.18      2015.72      180.41

 

but i want to get

 

3195.18      2015.72      171.44
3212.68      1845.18      148.79
3361.47      1845.18      100.58
3361.47      1945.75      180.41
3195.18      2015.72      

 

This way i can copy directly from autocad history and paste directly into the drawing, without having to copy on notepad and start editing.

 

Also if its a closed poly where start and end match, could we omit the last vertex. I can edit the mtext and just delete last line, if its too much hassle, so this last one is no big deal.

 

Thanx a lot for your help.

Posted

Please note that there are two types of "closed" polylines.   Consider a polyline that forms a closed shape square.  It could have 4 defined vertices and the "c" option was used to close it or it could have 5 vertices where the first and last vertices have the same location.

 

The following code will handle open polylines and polylines where the first and last vertex are the same with output per your latest posted request. It will not list the  distance for a "closed" polyline where the first and last vertex are not the same but the closed parameter was used.

 

 

;POLYVERT - list coordinates of polyline vertices
; 
;CAD Studio - www.cadstudio.cz  www.cadforum.cz
; modified by lrm 6/27/2019   v4
;
(setq __PV_Delimiter "      ")		; or ";" or (chr 9)
(setq __PV_DP (getvar "LUPREC"))	; decimal places
(command "-units" "" 2 "" "" "" "")
(defun C:POLYVERT (/ ent listCOORDINATES PT1)
  (setq ent (entsel "\nPick POLYLINE to list vertices:"))
  (if
    (and ent
	 (wcmatch (cdr (assoc 0 (entget (setq ent (car ent)))))
		  "*POLYLINE"
	 )				;all types
    )					;and
     (progn
       (setq listCOORDINATES (PolyVert ent)) ;make list
       (princ "\nVertex list (x y distance-from-previuos):")

       (setq pt0     (nth 0 listCOORDINATES)
	     ptStart pt0
       )
       (foreach	PT1 listCOORDINATES	;all vertices
	 (setq d (distance pt0 pt1))
	 (if (/= pt0 PT1)
	   (progn


	     (princ (strcat "\n"
			    (rtos (car pt0) 2 __PV_DP)
			    __PV_Delimiter
			    (rtos (cadr pt0) 2 __PV_DP)
			    __PV_Delimiter
			    (rtos d 2 __PV_DP)
			    __PV_Delimiter
		    )
	     )
	     display
	     XYZ
	     (setq pt0 pt1)
	   )				; progn
	 )				; end if
       )				;for
					; check if first and last vertex are the same
       (if (> (distance ptStart pt0) 0.001)
	 (progn
	   (princ (strcat "\n"
			  (rtos (car pt0) 2 __PV_DP)
			  __PV_Delimiter
			  (rtos	(cadr pt0
				)
				2
				__PV_DP
			  )
			  __PV_Delimiter

		  )
	   )
	 )				; progn
       )
     )					;progn
     (princ " no polyline selected")
  )					;if
  (princ)
)




; PolyVert
; returns vertices list for any type of polyline (in WCS coordinates)
; arg POLY: polyline to list (ename or vla-object)

(defun PolyVert	(POLY / par pt1 pt0 lst)
  (vl-load-com)
  (setq	par (if	(vlax-curve-isClosed POLY)
	      (vlax-curve-getEndParam POLY) ; else
	      (1+ (vlax-curve-getEndParam POLY))
	    )
  )
  (while (setq pt1 (vlax-curve-getPointAtParam POLY (setq par (- par 1))))
    (setq lst (cons pt1 lst))
  )
)					; return lst

(princ "\nPOLYVERT command loaded.")
(princ)

 

  • Like 1
Posted

Thanx man excellent work exactly what i needed. Now i got one less thing to worry about when doing CAD Work. Take Care.

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.

×
×
  • Create New...