Help lisp display text on 3D polyline

[tuantrinhdp]

Hi everyone. 
I need:
- display text ( no Z) on 3D polyline ( include: donut yellow, choose text height)
- convert 3D polyline to 2D polyline
Can you help me write lisp with my request, please? 

TEST.dwg

[BIGAL]

Try

Label 3dpolys
By Alan H April 2023

(defun c:wow ( / obj co-ords pt lst2 lwpoly)

(defun LWPoly (plst lay col cls)
 (entmakex (append (list 
   (cons 0 "LWPOLYLINE")
   (cons 100 "AcDbEntity")
   (cons 100 "AcDbPolyline")
   (cons 8 lay)
   (cons 62 col)
   (cons 90 (length plst))
   (cons 70 cls))
   (mapcar (function (lambda (p) (cons 10 p))) plst)
   )
 )
)

(Prompt "select 3d polylines ")
(setq ss (ssget '((0 . "POLYLINE"))))
(if ss
(repeat (setq k (sslength ss))
  (setq obj (vlax-ename->vla-object (ssname ss (setq k (1- k)))))
  (setq co-ords (vlax-get obj 'coordinates))
  (setq co-ordsxy '())
  (setq I 0)
  (repeat (/ (length co-ords) 3)
    (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) ))
    (setq co-ordsxy (cons xy co-ordsxy))
    (setq I (+ I 3))
  )
  (setq lst2 '())
  (foreach pt co-ordsxy
    (setq pt (list (car pt)(cadr pt) (caddr pt)))
    (command "text" "C" pt 1.5 0.0 (rtos (caddr pt) 2 2))
    (command "-insert" "Donut" "s" 1 (list (car pt)(cadr pt)) 0.0)
    (setq lst2 (cons (list (car pt)(cadr pt)) lst2))
  )

  (LWPoly lst2 (vla-get-layer obj) (vla-get-color obj) 0)
  (vla-delete obj)
)
(alert "No 3dpoly's chosen ")
)

(princ)
)

(c:wow)

this.

Edited April 16, 2023 by BIGAL

[tuantrinhdp]

6 minutes ago, BIGAL said:

Try

(defun co-ords2xy (xyz / )
(setq co-ordsxy '())
(if (= xyz 2)
(progn
(setq I 0)
(repeat (/ (length co-ords) 2)
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)
)
(if (= xyz 3)
(progn
(setq I 0)
(repeat (/ (length co-ords) 3)
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 3))
)
)
)
)

(defun c:wow ( / )
(setq obj (vlax-ename->vla-object (car  (entsel "Pick obj"))))

(setq co-ords (vlax-get obj 'coordinates))
(cond 
  (( = (vla-get-objectname obj) "AcDb2dPolyline")(co-ords2xy 2))
  (( = (vla-get-objectname obj) "AcDb3dPolyline")(co-ords2xy 3))
)
(princ co-ordsxy)

(foreach pt co-ordsxy
  (setq pt (list (car pt)(cadr pt) (caddr pt)))
  (command "text" "C" pt 1.5 0.0 (rtos (caddr pt) 2 2))
)

(princ)
)
(c:wow)

this.

Successful, can you help me to add block reference ( donut color yellow, - My attachment has a yellow block ref.) under the text?
With additional conditions to choose text size  ?
Thank you so much. 

[BIGAL]

Added donut

 

(foreach pt co-ordsxy
  (setq pt (list (car pt)(cadr pt) (caddr pt)))
  (command "text" "C" pt 1.5 0.0 (rtos (caddr pt) 2 2))
  (command "-insert" "Donut" "s" 1 (list (car pt)(cadr pt)) 0.0)
)

 

 

Edited April 10, 2023 by BIGAL

[mhupp]

Quote

 

 

22 hours ago, tuantrinhdp said:

- convert 3D polyline to 2D polyline

 

Use the flatten command

[tuantrinhdp]

1 hour ago, BIGAL said:

Added donut

 

(foreach pt co-ordsxy
  (setq pt (list (car pt)(cadr pt) (caddr pt)))
  (command "text" "C" pt 1.5 0.0 (rtos (caddr pt) 2 2))
  (command "-insert" "Donut" "s" 1 pt 0.0)
)

 

 

Thank you so much. 

[BIGAL]

I have updated the code in post 2to include more functionality, as requested. 

[ArbaDan75]

On 4/9/2023 at 10:14 AM, BIGAL said:

Try

Label 3dpolys
By Alan H April 2023

(defun c:wow ( / obj co-ords pt lst2 lwpoly)

(defun LWPoly (plst lay col cls)
 (entmakex (append (list 
   (cons 0 "LWPOLYLINE")
   (cons 100 "AcDbEntity")
   (cons 100 "AcDbPolyline")
   (cons 8 lay)
   (cons 62 col)
   (cons 90 (length plst))
   (cons 70 cls))
   (mapcar (function (lambda (p) (cons 10 p))) plst)
   )
 )
)

(Prompt "select 3d polylines ")
(setq ss (ssget '((0 . "POLYLINE"))))
(if ss
(repeat (setq k (sslength ss))
  (setq obj (vlax-ename->vla-object (ssname ss (setq k (1- k)))))
  (setq co-ords (vlax-get obj 'coordinates))
  (setq co-ordsxy '())
  (setq I 0)
  (repeat (/ (length co-ords) 3)
    (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) ))
    (setq co-ordsxy (cons xy co-ordsxy))
    (setq I (+ I 3))
  )
  (setq lst2 '())
  (foreach pt co-ordsxy
    (setq pt (list (car pt)(cadr pt) (caddr pt)))
    (command "text" "C" pt 1.5 0.0 (rtos (caddr pt) 2 2))
    (command "-insert" "Donut" "s" 1 (list (car pt)(cadr pt)) 0.0)
    (setq lst2 (cons (list (car pt)(cadr pt)) lst2))
  )

  (LWPoly lst2 (vla-get-layer obj) (vla-get-color obj) 0)
  (vla-delete obj)
)
(alert "No 3dpoly's chosen ")
)

(princ)
)

(c:wow)

this.

 

Edited April 28, 2023 by ArbaDan75

[ArbaDan75]

Tahnks! Very nice!

You could substitute  "(command "-insert" "Donut" "s" 1 (list (car pt)(cadr pt)) 0.0)"  with  "(command "point"  pt)".

Edited April 28, 2023 by ArbaDan75