Get Polyline segments

[Bruno.Valsecchi]

Hi,

I have this ! Make directely a table in Autocad with the one or more polylines selected.
If can help you !

(vl-load-com)
(defun c:mult-info_po2cell ( / js obj ename n AcDoc Space pr nb lst_id-seg lst_pt lst_length lst_alpha lst_rad id all_path j end_pos id_path fonts_path file_shx
                               nw_obj nw_style dist_start dist_end pt_start pt_end seg_len seg_bulge rad alpha oldim oldlay h_t w_c ename_cell n_row n_column)
	(princ "\nSelect polylines.")
	(while (null (setq js (ssget '((0 . "LWPOLYLINE")))))
		(princ "\nSelection empty, or is not a available polyline!")
	)
	(setq
		AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
		Space
		(if (= 1 (getvar "CVPORT"))
			(vla-get-PaperSpace AcDoc)
			(vla-get-ModelSpace AcDoc)
		)
	)
	(cond
		((null (tblsearch "LAYER" "Table-Polyline"))
			(vla-add (vla-get-layers AcDoc) "Table-Polyline")
		)
	)
	(cond
		((null (tblsearch "STYLE" "Text-Cell"))
			(setq all_path (getenv "ACAD") j 0)
			(while (setq end_pos (vl-string-position (ascii ";") all_path))
				(setq id_path (substr all_path 1 end_pos))
				(if (wcmatch (strcase id_path) "*FONTS*")
					(setq fonts_path (strcat id_path "\\"))
				)
				(setq all_path (substr all_path (+ 2 end_pos)))
			)
			(setq file_shx (getfiled "Select a font file " fonts_path "shx" 8))
			(if (not file_shx)
				(setq file_shx "txt.shx")
			)
			(setq nw_style (vla-add (vla-get-textstyles AcDoc) "Text-Cell"))
			(mapcar
				'(lambda (pr val)
					(vlax-put nw_style pr val)
				)
				(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
				(list file_shx 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
			)
			(command "_.ddunits"
				(while (not (zerop (getvar "cmdactive")))
					(command pause)
				)
			)
		)
	)
	(setq
		oldim (getvar "dimzin")
		oldlay (getvar "clayer")
	)
	(setvar "dimzin" 0) (setvar "clayer" "Table-Polyline")
	(initget 9)
	(setq ins_pt_cell (getpoint "\nLeft-Up insert point of table: "))
	(initget 6)
	(setq h_t (getdist ins_pt_cell (strcat "\nHigth text <" (rtos (getvar "textsize")) ">: ")))
	(if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
	(initget 7)
	(setq w_c (getdist ins_pt_cell "\nWidth of cells: "))
	(setq
		lst_id-seg '()
		lst_pt '()
		lst_length '()
		lst_alpha '()
		lst_rad '()
		nb 0
		id 0
	)
	(repeat (setq n (sslength js))
		(setq
			obj (ssname js (setq n (1- n)))
			ename (vlax-ename->vla-object obj)
			pr -1
			id (1+ id)
		)
		(repeat (fix (vlax-curve-getEndParam ename))
			(setq
				dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr)))
				dist_end (vlax-curve-GetDistAtParam ename (1+ pr))
				pt_start (vlax-curve-GetPointAtParam ename pr)
				pt_end (vlax-curve-GetPointAtParam ename (1+ pr))
				seg_len (- dist_end dist_start)
				seg_bulge (vla-GetBulge ename pr)
				rad (if (zerop seg_bulge) 0.0 (/ seg_len (* 4.0 (atan seg_bulge))))
				alpha (if (zerop seg_bulge) (angle pt_start pt_end) 0.0)
				lst_id-seg (cons (strcat "P" (itoa id) "-" (itoa nb)) lst_id-seg)
				lst_pt (cons pt_start lst_pt)
				lst_length (cons seg_len lst_length)
				lst_rad (cons (abs rad) lst_rad)
				lst_alpha (cons alpha lst_alpha)
				nb (1+ nb)
			)
		)
		(if (eq (vla-get-closed ename) :vlax-false)
			(setq lst_id-seg (cons (strcat "P" (itoa id) "-" (itoa nb)) lst_id-seg))
			(setq lst_id-seg (cons (strcat "P" (itoa id) "-" (itoa (- nb (fix (vlax-curve-getEndParam ename))))) lst_id-seg))
		)
		(setq
			lst_pt (cons pt_end lst_pt)
			lst_length (cons 0.0 lst_length) lst_rad (cons 0.0 lst_rad) lst_alpha (cons 0.0 lst_alpha)
			nb (1+ nb)
		)
	)
	(mapcar
		'(lambda (p tx)
			(setq nw_obj
				(vla-addMtext Space
					(vlax-3d-point p)
					0.0
					tx
				)
			)
			(mapcar
				'(lambda (pr val)
					(vlax-put nw_obj pr val)
				)
				(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
				(list 5 h_t 5 p "Text-Cell" "Table-Polyline" 0.0)
			)
		)
		lst_pt
		lst_id-seg
	)
	(vla-addTable Space (vlax-3d-point ins_pt_cell) (+ 2 nb) 6 (+ h_t (* h_t 0.25)) w_c)
	(setq ename_cell (vlax-ename->vla-object (entlast)) n_row (1+ nb) n_column -1)
	(vla-SetCellValue ename_cell 0 0
		(vlax-make-variant
			(strcat "Summary of " (itoa (sslength js)) " LWPOLYLINES")
			8
		)
	)
	(vla-SetCellTextStyle ename_cell 0 0 "Text-Cell")
	(vla-SetCellTextHeight ename_cell 0 0 (vlax-make-variant h_t 5))
	(vla-SetCellAlignment ename_cell 0 0 5)
	(foreach n
		(mapcar'list
			(append lst_id-seg '("N°"))
			(append (mapcar 'rtos (mapcar 'car lst_pt)) '("Coordinates X"))
			(append (mapcar 'rtos (mapcar 'cadr lst_pt)) '("Coordinates Y"))
			(append (mapcar 'rtos lst_length) '("Lengths"))
			(append (mapcar 'angtos lst_alpha) '("Directions"))
			(append (mapcar 'rtos lst_rad) '("Radius"))
		)
		(mapcar
			'(lambda (el)
				(vla-SetCellValue ename_cell n_row (setq n_column (1+ n_column))
					(if (or (eq (rtos 0.0) el) (eq (angtos 0.0) el)) (vlax-make-variant "_" 8) (vlax-make-variant el 8))
				)
				(vla-SetCellTextStyle ename_cell n_row n_column "Text-Cell")
				(vla-SetCellTextHeight ename_cell n_row n_column (vlax-make-variant h_t 5))
				(if (eq n_row 1)
					(vla-SetCellAlignment ename_cell n_row n_column 5)
					(vla-SetCellAlignment ename_cell n_row n_column 6)
				)
			)
			n
		)
		(setq n_row (1- n_row) n_column -1)
	)
	(setvar "dimzin" oldim) (setvar "clayer" oldlay)
	(prin1)
)

[cadplayer]

@fixo: yes it work´s

Now I want to connect all coords from different polylines. Is it possible in the function?
So I can select one or more polylines.
This example works with on polyline, how can I do it for more polylines

;select multi entity
  (setq ss (ssget '((0 . "LWPOLYLINE")) ))
  (repeat
    (progn
      (setq ssn (sslength ss))
      (setq ent (ssname ss (setq ssn (1- ssn))))
      (setq ssn (1+ ssn))
      )
    )
  
;; if Esc pressed
   (if (not ent)
     (progn
       (exit)
       (princ))
    )
;; if selected, convert it to VLA-object
(setq pln (vlax-ename->vla-object ent))
 
 ;; get coordinates
(setq coords (get-vexs pln))
  (setq closed (if (eq :vlax-true (vla-get-closed pln))
         t
                 nil)
        )

[fixo]

@fixo: yes it work´s

Now I want to connect all coords from different polylines. Is it possible in the function?
So I can select one or more polylines.
This example works with on polyline, how can I do it for more polylines

;select multi entity
(setq ss (ssget '((0 . "LWPOLYLINE")) ))
(repeat
(progn
(setq ssn (sslength ss))
(setq ent (ssname ss (setq ssn (1- ssn))))
(setq ssn (1+ ssn))
)
)

;; if Esc pressed
(if (not ent)
(progn
(exit)
(princ))
)
;; if selected, convert it to VLA-object
(setq pln (vlax-ename->vla-object ent))

;; get coordinates
(setq coords (get-vexs pln))
(setq closed (if (eq :vlax-true (vla-get-closed pln))
t
nil)
)

Show us the resulting Excel/csv file
I don't understand how it should be looks like
Or upload thescreenshot of this file as .jpg or .png here
In my opinion every polyline record must be separated with any
description or label,
something like

#poliline #1
.....
#poliline #2
...... ETC

Or you want to select many by clicking one by one
Please explain us more
Just a hint: look for asmitools on Google, not sure about
bit I've seen something similar in there, probably named
tabcoords.lsp or tabcoord.lsp

right now I'm busy..

[cadplayer]

Its not hurry!
Hopefully you understand it better

Your program works perfekt if I have only one polyline, but I have much more...
I think it would be great if it works with selectionset (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE")))).

Simple example:

(setq num (getint "\nSelect start number: "))
(setq num (- num 1))
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(setq i1 0)
(repeat (sslength ss)
  (setq ename (ssname ss i1))
  (setq edata (entget ename))
  (cond
    ((= (cdr (assoc 0 edata)) "LWPOLYLINE")
     (foreach n1 edata
       (cond
     ((= (car n1) 10)
      (setq Punktliste (cons (cdr n1) Punktliste))
      (setq num (1+ num))
      (command "insert" "koordinatpunkt" (car Punktliste) 1 1 0 (itoa num))
      )
     )
       )
     )
    )
  )

In your program is´nt easy to insert my simple-routine
Is it much more work, if I´d like to have excel-list some attachment

[fixo]

Ok, I will be back in tomorrow

[fixo]

I just added a few lines of code
and tested one time only -
seem like it's kinda working on my end
Try again

[cadplayer]

Yes fantastic, it works - some littleness

Here is something wrong. Program breaks if I don´t select polyline

 (while (setq ent (entsel "\n\t>>>\tSelect polyline\t<<<\n"))
  (if (not ent)
    (while (or (not ent)(not (eq (strcase (cdr (assoc 0 (entget (car ent))))T )"lwpolyline")))
      (princ "\nNothing or wrong object type selected, try again... ")
      (setq ent (entsel  "\n\t>>>\tYou have to pick single LWPOLYLINE only\t<<<\n")))
    )

I think it could be so

(while
  (cond
    ((setq ent (entsel "\n\t>>>\tSelect polyline\t<<<\n"))
     nil)
    ((setq ent (entsel  "\n\t>>>\tYou have to pick single LWPOLYLINE only\t<<<\n"))
     T)
    (princ "\nNothing or wrong object type selected, try again... ")
    )
  )

But it does´nt work
Can you fix it?

[steveo]

I just added a few lines of code
and tested one time only -
seem like it's kinda working on my end
Try again

Can someone please post the block dwg of "koordinatpunkt" ?? so we can all play too ! !

[fixo]

Yes fantastic, it works - some littleness

Here is something wrong. Program breaks if I don´t select polyline

(while (setq ent (entsel "\n\t>>>\tSelect polyline\t<<<\n"))
(if (not ent)
(while (or (not ent)(not (eq (strcase (cdr (assoc 0 (entget (car ent))))T )"lwpolyline")))
(princ "\nNothing or wrong object type selected, try again... ")
(setq ent (entsel "\n\t>>>\tYou have to pick single LWPOLYLINE only\t<<<\n")))
)

I think it could be so

(while
(cond
((setq ent (entsel "\n\t>>>\tSelect polyline\t<<<\n"))
nil)
((setq ent (entsel "\n\t>>>\tYou have to pick single LWPOLYLINE only\t<<<\n"))
T)
(princ "\nNothing or wrong object type selected, try again... ")
)
)
But it does´nt work
Can you fix it?

Oh man
Do not to be so complicated
Wouldn'l be easy to use a selection with filter instead
See edited

[cadplayer]

this is block koordinatpunkt

Ohh fixo it´s fantastic - you help me so much, you´re like Santa Claus - its a big present for me and I have to learn now.
Thank you so much.