Custom polyLine with text

[cadmando2]

is it possable to create a custom polyline to attach in information to it like "pipe size" "lenth" "HWS" "HWR".
what I'm looking to do is draw a Piping, Electrical wire or single line duct layout with the info above the pline! or even edit the info. what would be nice is to draw pline and go back over and select the pline and the info would be place over the pline or option to have leader line with the info!
can anyone help me!
Ployline.jpg

[Adesu]

As suggest, would you post here a drawing before and after revised, with drawing I easy to understand.

is it possable to create a custom polyline to attach in information to it like "pipe size" "lenth" "HWS" "HWR".
what I'm looking to do is draw a Piping, Electrical wire or single line duct layout with the info above the pline! or even edit the info. what would be nice is to draw pline and go back over and select the pline and the info would be place over the pline or option to have leader line with the info!
can anyone help me!

[rkmcswain]

Note: Changed the thread title to make it a bit more descriptive

[fixo]

I wrote this some time ago for one guy
from discussion.group forum
Here are two lisps just slightly edited to your suit,
the first one will add the extended data to the selected pipes,
and the second will draw the table and populate
them with extended data

;; first lisp
;; xar.lsp
;; first select one by one all what you need with accuracy
;; and add xdata
(vl-load-com)

(defun C:XAR (/	)

(setq osm (getvar "osmode")); store osmode
(setvar "osmode" 512)
(setvar "cmdecho" 0); turn echo off
(regapp "PIPEINFO"); first of register application in ACAD.
;; This would be stored in the table APPID
;; loop through selected plines:
(while
(setq pickpt (getpoint "\nPick point on pline (hit Enter to exit loop): ")); pick point on entity
(setq ps  (getreal "\nPipe size: ")
      ln   (getreal "\nLength: ")
      hws (getstring T "\nHWS: ")
      hwr  (getstring T "\nHWR: ")
      )

(setq en (ssname (ssget "C" pickpt pickpt (list (cons 0 "*POLYLINE")))0))

(setq elist (entget en))
;build extension data 
(setq
xdata (list
(list -3 (list "PIPEINFO"
	       (cons 1040 ps);real
	       (cons 1041 ln);distance
	       (cons 1000 hws);string	       
	       (cons 1000 hwr);string	       
	       ))
)
)
(setq xdlist (append elist xdata));append extension data to entity list
(entmod xdlist); setting data, modify entity list
(entupd en); update entity, optonal
); end loop
(setvar "osmode" osm); restore osmode
(setvar "cmdecho" 1); turn echo on
  (princ)
)
(prompt
  "\n\t\t\t   |-----------------------------|"
)
(prompt
  "\n\t\t\t  <|  Start with XAR to execute  |>"
)
(prompt
  "\n\t\t\t   |-----------------------------|"
)
  (princ)


;; second lisp
;; art.lsp

;; here is follows part to draw the table

  (vl-load-com)

;; local defuns:

; read extension data:
(defun get_xdata (vobj apname)
(or (vl-load-com))
(if (and vobj apname)
(progn
(vla-getxdata vobj apname 'xtypeOut 'xdataOut) 
(setq xtp (vlax-safearray->list xtypeOut))
(setq dtp (mapcar (function (lambda (x)
		(vlax-variant-value x)))
		  (vlax-safearray->list xdataOut)))
dtp
)
)
)

;Then you can get all xdata:
(defun getallxdata (appname / acapp adoc axss table_data tmp)
  (or (vl-load-com))
  (or acapp (setq acapp (vlax-get-acad-object)))
  (or adoc (setq adoc (vla-get-activedocument acapp)))
  (if (ssget "X" (list (cons 0  "*POLYLINE")
		       (list -3 (list appname))))
    (progn
    (setq axss (vla-get-activeselectionset adoc))
    (vlax-for a axss
      (if
      (setq tmp (cdr (get_xdata a appname)))
      (setq table_data (cons tmp table_data))))))
    (reverse table_data)
  )

;; create table style

(defun make-tablestyle ( name desc txtstyle h1 h2 h3 / tblstyle adoc)
  (or (vl-load-com))
  (setq 
    tblstyle (vla-addobject 
      (vla-item (vla-get-dictionaries 
             (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
             ) 
           "Acad_Tablestyle" 
           ) 
      name 
      "AcDbTableStyle" 
      ) 
    )
  (setq acmCol (vla-getinterfaceobject
	       (vlax-get-acad-object)
	       (strcat "AutoCAD.AcCmColor."
		       (substr (getvar "ACADVER") 1 2))))  
  (vla-put-name tblstyle name)
  
  (vla-put-headersuppressed tblstyle :vlax-false) 
  (vla-put-titlesuppressed tblstyle :vlax-false)
  (vla-put-description tblstyle desc) 
  (vla-put-flowdirection tblstyle 0)
  (vla-put-bitflags tblstyle 1)
  (vla-put-horzcellmargin tblstyle (/ h3 5))  
  (vla-put-vertcellmargin tblstyle (/ h3 5))
  (vla-settextstyle tblstyle 7 txtstyle)
  (vla-settextheight tblstyle 1 h3)  
  (vla-settextheight tblstyle 4 h2) 
  (vla-settextheight tblstyle 2 h1) 

  (vla-setrgb acmCol 204 102 0)
  (vla-setgridcolor tblstyle 63 7 acmCol)
  
  (vla-setgridvisibility tblstyle 63 7 :vlax-true) 
  (vla-setgridlineweight  tblstyle 18 7 aclnwt009) 
  (vla-setgridlineweight tblstyle 45 7 aclnwt050) 

  (vlax-release-object acmCol)
  )
;==================== * main part * ========================;

;=========== * create table from extended data * ===========;

(defun C:ART (/ Acmcol Acsp Adoc Axss Col Columns Dht Headers Ipt Objtable Row Rows Table_Data)
  (if (< (atof (getvar "ACADVER")) 16.0)
  (alert "This routine will work\nfor versions A2005 and higher")
  (progn
  (alert "\tBe patience\n\tWorks slowly")
 
  (or adoc
    (setq adoc (vla-get-activedocument
  (vlax-get-acad-object))))
  (or acsp (setq acsp (if (= (getvar "TILEMODE") 0)
  (vla-get-paperspace
  adoc)
  (vla-get-modelspace
  adoc))
  )
  )
  (vl-catch-all-apply (function (lambda()
  (make-tablestyle "PipeInfo" "Electric Table" "Standard" 10.0 10.0 12.0))))
  (setq acmCol (vla-getinterfaceobject
	       (vlax-get-acad-object)
	       (strcat "AutoCAD.AcCmColor."
		       (substr (getvar "ACADVER") 1 2))))
  (setq dht (getvar "dimtxt"))

;;;  (setq lst_count nil)
  (setq table_data (getallxdata "PIPEINFO"))
  (setq table_data (mapcar (function (lambda(x)
		   (mapcar 'vl-princ-to-string x)))
			   table_data))
(setq	columns	 (length (car table_data)) 
	rows	 (length table_data)
	ipt (getpoint "\nUpper left table insertion point: \n")
  )

      (setq objtable (vlax-invoke
		      acsp
		      "AddTable"
		      ipt
		      (+ 2 rows)
		      columns
		 ;; rows height (change by suit):
		 (* dht 1.667);28
		 ;; columns width (change by suit):
		 (* dht 10);50
	       )
       )
  (vla-put-regeneratetablesuppressed objtable :vlax-true)
  (vla-put-titlesuppressed objtable :vlax-false)
  (vla-put-headersuppressed objtable :vlax-false)  

  (vla-put-titlesuppressed objtable :vlax-false)
  (vla-put-headersuppressed objtable :vlax-false)
  (vla-put-horzcellmargin objtable (* dht 0.5))
  (vla-put-vertcellmargin objtable (* dht 0.5))
  (vla-put-layer objtable "0")
  (vla-settextstyle objtable 2 "Standard")
  (vla-settextstyle objtable 4 "Standard")
  (vla-settextstyle objtable 1 "Standard")
  
  (vla-setrowheight objtable 1 (* dht 1.5))
  (vla-setrowheight objtable 2 (* dht 1.25))

  
  (vla-settextheight objtable 2 (* dht 1.25))
  (vla-settextheight objtable 4 dht)
  (vla-settextheight objtable 1 dht)
  
  (vla-put-colorindex acmcol 256)
  (vla-put-truecolor objtable acmcol)
  
  (vla-setcolumnwidth objtable 0 (* dht 10))
  (vla-setcolumnwidth objtable 1 (* dht 15))
  (vla-setcolumnwidth objtable 2 (* dht 10))
  (vla-setcolumnwidth objtable 3 (* dht 15))
  
  (vla-put-colorindex acmcol 2)
  (vla-settext objtable 0 0 "Pipes Info") 
  (vla-setcelltextheight objtable 0 0 (* dht 1.5))
  (vla-setcellcontentcolor objtable 0 0 acmcol)
  (vla-put-colorindex acmcol 102)
  (setq	headers	'("Pipe Size" "Length" "HWS" "HWR")
  )
  
  (setq	col 0
	row 1
  )
  (foreach a headers
    (vla-settext objtable row col a)
    (vla-setcelltextheight objtable row col (* dht 1.25))
    (vla-setcellcontentcolor objtable row col acmcol)
    (setq col (1+ col))
  )
(vla-put-colorindex acmcol 40)  
(setq  row 2 col 0)

  (foreach i table_data
  (vla-setrowheight objtable row (* dht 1.25))  
  (setq col 0)
  (foreach a i
    (vla-settext objtable row col a)
    (if (/= col 1)
    (vla-setcellalignment objtable row col acMiddleLeft)
    (vla-setcellalignment objtable row col acMiddleCenter))
    (vla-setcellcontentcolor objtable row col acmcol)
    (setq col (1+ col)))
    (setq row (1+ row))
    )
  (vla-put-colorindex acmcol 12)

  (vla-setcellcontentcolor objtable row 1 acmcol)
  (vla-put-regeneratetablesuppressed objtable :vlax-false)
  (vl-catch-all-apply
    (function
      (lambda ()
	(progn
	  (vla-clear axss)
	  (vla-delete axss)
	  (mapcar 'vlax-release-object (list axss objtable))
	  )
	)
      )
    )
  (vla-regen adoc acactiveviewport)
  (alert "Done")
  )
    )
  (princ)
)

(prompt
  "\n\t\t\t   |-----------------------------|"
)
(prompt
  "\n\t\t\t  <|  Start with ART to execute  |>"
)
(prompt
  "\n\t\t\t   |-----------------------------|"
)
  (princ)

~'J'~

[cadmando2]

Thanks for the code.
is this code you wrote, what verision of cad will it work with!
I'm using autoCAD 2004 and when I loaded the code and type in xar and selected pline or line I got is error!
; error: bad DXF group: (-3 ("PIPEINFO" (1040 . 3.0) (1041) (1000 . "") (1000 .
"HWR")))

type in art and got this Error.
; error: ActiveX Server returned the error: unknown name: "AddTable"

[fixo]

I'm not sure about but I think that
AcadTable object was embedded into
AutoCAD starting from A2006 version only
You need to draw instead the plain table
with using of lines
I have the similar programm that will do it
but I need a time to rewrite them to this
suit.
Perhaps tomorrow I'll free for this work
Later,

~'J'~

[fixo]

Thanks for the code.
is this code you wrote, what verision of cad will it work with!
I'm using autoCAD 2004 and when I loaded the code and type in xar and selected pline or line I got is error!
; error: bad DXF group: (-3 ("PIPEINFO" (1040 . 3.0) (1041) (1000 . "") (1000 .
"HWR")))

type in art and got this Error.
; error: ActiveX Server returned the error: unknown name: "AddTable"

Okay, I have to rewrote it for your version
Give this a try

;; xar.lsp
;; first select one by one all what you need with accuracy
;; and add xdata
(vl-load-com)

(defun C:XAR (/	)

(setq osm (getvar "osmode")); store osmode
(setvar "osmode" 512)
(setvar "cmdecho" 0); turn echo off
(regapp "PIPEINFO"); first of register application in ACAD.
;; This would be stored in the table APPID
;; loop through selected enforcements:
(while
(setq pickpt (getpoint "\nPick point on enforcement: ")); pick point on entity
(setq ps  (getreal "\nPipe size: ")
      ln   (getreal "\nLength: ")
      hws (getstring T "\nHWS: ")
      hwr  (getstring T "\nHWR: ")
      )

(setq en (ssname (ssget "C" pickpt pickpt (list (cons 0 "*POLYLINE")))0))

(setq elist (entget en))
;build extension data 
(setq
xdata (list
(list -3 (list "PIPEINFO"
	       (cons 1040 ps);real
	       (cons 1041 ln);distance
	       (cons 1000 hws);string	       
	       (cons 1000 hwr);string	       
	       ))
)
)
(setq xdlist (append elist xdata));append extension data to entity list
(entmod xdlist); setting data, modify entity list
(entupd en); update entity, optonal
); end loop
(setvar "osmode" osm); restore osmode
(setvar "cmdecho" 1); turn echo on
  (princ)
)
(prompt
  "\n\t\t\t   |-----------------------------|"
)
(prompt
  "\n\t\t\t  <|  Start with XAR to execute  |>"
)
(prompt
  "\n\t\t\t   |-----------------------------|"
)
  (princ)


;; second lisp

;; ptd.lsp

(vl-load-com)

;; local defuns:

; read extension data:
(defun get_xdata (vobj apname)
(or (vl-load-com))
(if (and vobj apname)
(progn
(vla-getxdata vobj apname 'xtypeOut 'xdataOut) 
(setq xtp (vlax-safearray->list xtypeOut))
(setq dtp (mapcar (function (lambda (x)
		(vlax-variant-value x)))
		  (vlax-safearray->list xdataOut)))
dtp
)
)
)

;Then you can get all xdata:
(defun getallxdata (appname / acapp adoc axss table_data tmp)
  (or (vl-load-com))
  (or acapp (setq acapp (vlax-get-acad-object)))
  (or adoc (setq adoc (vla-get-activedocument acapp)))
  (if (ssget "X" (list (cons 0  "*POLYLINE")
		       (list -3 (list appname))))
    (progn
    (setq axss (vla-get-activeselectionset adoc))
    (vlax-for a axss
      (if
      (setq tmp (cdr (get_xdata a appname)))
      (setq table_data (cons tmp table_data))))))
    (reverse table_data)
  )

(defun C:PTD (/	cnt	     com_height	  dht	       num	    p0		 rows	      row_height   table_data
		table_headers		  table_height title_height title_text_height	      tmp	   txt_line
		txt_xpos     wid	  wids	       x	    y)


  (setq table_data (getallxdata "PIPEINFO"))
  (setq table_data (mapcar (function (lambda(x)
		   (mapcar 'vl-princ-to-string x)))
			   table_data))
  (setq table_headers
'("Pipe Size" "Length" "HWS" "HWR"))
;;==================TABLE CALCULATION=====================;;
(setq dht (getvar "textsize")
      title_text_height (* dht 1.5)
      row_height (* dht 2.)
      title_height (* row_height 1.5)
      rows (length table_data))
  (setq cnt 0)
  (repeat (length table_headers)
    (setq tmp (* (strlen (nth cnt table_headers)) dht 1.25)
	  wids (cons tmp wids)
	  tmp nil
	  cnt (1+ cnt)))
  (setq wids (reverse wids)
	wid (apply '+ wids))
  (setq p0 (getpoint "\nSpecify upper left point of table : \n"))
  (setq x (car p0)
	y (cadr p0)
	txt_xpos (append (list 0.0)(reverse (cdr (reverse wids)))))

;;========================TITLE=========================;;
  (entmake
      (list '(0 . "LINE") (cons 10  p0)
	    (cons 11 (list (+ x wid) y))))
  (setq y (- y  title_height))
  (entmake
      (list '(0 . "LINE") (cons 10  (list x y))
	    (cons 11 (list (+ x wid) y))))
  (entmake (list '(0 . "TEXT")(cons 1 "Pipes Info")
  (cons 10 (list (+ x (/ wid 2)(/ dht 2))
		 (+ y (/ dht 2))))
  (cons 11 (list (+ x (/ wid 2)(/ dht 2))
		 (+ y (/ dht 2))))
	   (cons 40 title_text_height) '(71 . 0)'(72 . 1)'(73 . 0)))
  ;;========================HEADER=========================;;
  (setq cnt 0 y (- y row_height))
  (entmake
      (list '(0 . "LINE") (cons 10  (list x y))
	    (cons 11 (list (+ x wid) y))))
  (repeat (length table_headers)
    (setq x (+ x (nth cnt txt_xpos)))
  (entmake (list '(0 . "TEXT")(cons 1 (nth cnt table_headers))
  (cons 10 (list (+ x (/ dht 2))
		 (+ y (/ dht 2))))
	   (cons 40 dht) '(72 . 0)))
    (setq cnt (1+ cnt)))
  ;;========================TABLE=========================;;
  (setq num 0 x (car p0) y (- y row_height))
  (repeat rows
    (entmake
      (list '(0 . "LINE") (cons 10  (list x y))
	    (cons 11 (list (+ x wid) y))))
    (setq txt_line (nth num table_data)
	  cnt 0)
    (repeat (length txt_line)
      (setq x (+ x (nth cnt txt_xpos)))
      (entmake (list '(0 . "TEXT")(cons 1 (nth cnt txt_line))
  (cons 10 (list (+ x (/ dht 2))
		 (+ y (/ dht 2))))
	   (cons 40 dht) '(72 . 0)))
      (setq cnt (1+ cnt)))
    (setq num (1+ num)
	  x (car p0)
	  y (- y row_height)))
  ;;===============VERTICAL LINES=================;;
  (setq table_height (* (1+ rows) row_height)
	com_height (+ table_height title_height))
  (entmake
      (list '(0 . "LINE") (cons 10  p0)
	    (cons 11 (list x (- (cadr p0) com_height)))))
  (entmake
      (list '(0 . "LINE") (cons 10  (list (+ x wid)(cadr p0)))
	    (cons 11 (list (+ x wid) (- (cadr p0) com_height)))))
  (setq txt_xpos (cdr txt_xpos))
  (setq cnt 0)
  (repeat (length txt_xpos)
    (setq x (+ x (nth cnt txt_xpos)))
  (entmake
      (list '(0 . "LINE") (cons 10  (list x (- (cadr p0) title_height )))
	    (cons 11 (list x (- (cadr p0) title_height table_height)))))
    (setq cnt (1+ cnt)
	  ))
    (alert "Done")

  (princ)
)
(prompt
  "\n\t\t\t   |-----------------------------|"
)
(prompt
  "\n\t\t\t  <|  Start with PTD to execute  |>"
)
(prompt
  "\n\t\t\t   |-----------------------------|"
)
  (princ)

~'J'~

[doru10]

Very interesting and useful lisp.
I would be interested to enter data using DCL (see dwg).
I'm use Acad2008.
Best Regards.

Okay, I have to rewrote it for your version
Give this a try

;; xar.lsp
;; first select one by one all what you need with accuracy
;; and add xdata
(vl-load-com)

(defun C:XAR (/    )

(setq osm (getvar "osmode")); store osmode
(setvar "osmode" 512)
(setvar "cmdecho" 0); turn echo off
(regapp "PIPEINFO"); first of register application in ACAD.
;; This would be stored in the table APPID
;; loop through selected enforcements:
(while
(setq pickpt (getpoint "\nPick point on enforcement: ")); pick point on entity
(setq ps  (getreal "\nPipe size: ")
      ln   (getreal "\nLength: ")
      hws (getstring T "\nHWS: ")
      hwr  (getstring T "\nHWR: ")
      )

(setq en (ssname (ssget "C" pickpt pickpt (list (cons 0 "*POLYLINE")))0))

(setq elist (entget en))
;build extension data 
(setq
xdata (list
(list -3 (list "PIPEINFO"
           (cons 1040 ps);real
           (cons 1041 ln);distance
           (cons 1000 hws);string           
           (cons 1000 hwr);string           
           ))
)
)
(setq xdlist (append elist xdata));append extension data to entity list
(entmod xdlist); setting data, modify entity list
(entupd en); update entity, optonal
); end loop
(setvar "osmode" osm); restore osmode
(setvar "cmdecho" 1); turn echo on
  (princ)
)
(prompt
  "\n\t\t\t   |-----------------------------|"
)
(prompt
  "\n\t\t\t  <|  Start with XAR to execute  |>"
)
(prompt
  "\n\t\t\t   |-----------------------------|"
)
  (princ)


;; second lisp

;; ptd.lsp

(vl-load-com)

;; local defuns:

; read extension data:
(defun get_xdata (vobj apname)
(or (vl-load-com))
(if (and vobj apname)
(progn
(vla-getxdata vobj apname 'xtypeOut 'xdataOut) 
(setq xtp (vlax-safearray->list xtypeOut))
(setq dtp (mapcar (function (lambda (x)
        (vlax-variant-value x)))
          (vlax-safearray->list xdataOut)))
dtp
)
)
)

;Then you can get all xdata:
(defun getallxdata (appname / acapp adoc axss table_data tmp)
  (or (vl-load-com))
  (or acapp (setq acapp (vlax-get-acad-object)))
  (or adoc (setq adoc (vla-get-activedocument acapp)))
  (if (ssget "X" (list (cons 0  "*POLYLINE")
               (list -3 (list appname))))
    (progn
    (setq axss (vla-get-activeselectionset adoc))
    (vlax-for a axss
      (if
      (setq tmp (cdr (get_xdata a appname)))
      (setq table_data (cons tmp table_data))))))
    (reverse table_data)
  )

(defun C:PTD (/    cnt         com_height      dht           num        p0         rows          row_height   table_data
        table_headers          table_height title_height title_text_height          tmp       txt_line
        txt_xpos     wid      wids           x        y)


  (setq table_data (getallxdata "PIPEINFO"))
  (setq table_data (mapcar (function (lambda(x)
           (mapcar 'vl-princ-to-string x)))
               table_data))
  (setq table_headers
'("Pipe Size" "Length" "HWS" "HWR"))
;;==================TABLE CALCULATION=====================;;
(setq dht (getvar "textsize")
      title_text_height (* dht 1.5)
      row_height (* dht 2.)
      title_height (* row_height 1.5)
      rows (length table_data))
  (setq cnt 0)
  (repeat (length table_headers)
    (setq tmp (* (strlen (nth cnt table_headers)) dht 1.25)
      wids (cons tmp wids)
      tmp nil
      cnt (1+ cnt)))
  (setq wids (reverse wids)
    wid (apply '+ wids))
  (setq p0 (getpoint "\nSpecify upper left point of table : \n"))
  (setq x (car p0)
    y (cadr p0)
    txt_xpos (append (list 0.0)(reverse (cdr (reverse wids)))))

;;========================TITLE=========================;;
  (entmake
      (list '(0 . "LINE") (cons 10  p0)
        (cons 11 (list (+ x wid) y))))
  (setq y (- y  title_height))
  (entmake
      (list '(0 . "LINE") (cons 10  (list x y))
        (cons 11 (list (+ x wid) y))))
  (entmake (list '(0 . "TEXT")(cons 1 "Pipes Info")
  (cons 10 (list (+ x (/ wid 2)(/ dht 2))
         (+ y (/ dht 2))))
  (cons 11 (list (+ x (/ wid 2)(/ dht 2))
         (+ y (/ dht 2))))
       (cons 40 title_text_height) '(71 . 0)'(72 . 1)'(73 . 0)))
  ;;========================HEADER=========================;;
  (setq cnt 0 y (- y row_height))
  (entmake
      (list '(0 . "LINE") (cons 10  (list x y))
        (cons 11 (list (+ x wid) y))))
  (repeat (length table_headers)
    (setq x (+ x (nth cnt txt_xpos)))
  (entmake (list '(0 . "TEXT")(cons 1 (nth cnt table_headers))
  (cons 10 (list (+ x (/ dht 2))
         (+ y (/ dht 2))))
       (cons 40 dht) '(72 . 0)))
    (setq cnt (1+ cnt)))
  ;;========================TABLE=========================;;
  (setq num 0 x (car p0) y (- y row_height))
  (repeat rows
    (entmake
      (list '(0 . "LINE") (cons 10  (list x y))
        (cons 11 (list (+ x wid) y))))
    (setq txt_line (nth num table_data)
      cnt 0)
    (repeat (length txt_line)
      (setq x (+ x (nth cnt txt_xpos)))
      (entmake (list '(0 . "TEXT")(cons 1 (nth cnt txt_line))
  (cons 10 (list (+ x (/ dht 2))
         (+ y (/ dht 2))))
       (cons 40 dht) '(72 . 0)))
      (setq cnt (1+ cnt)))
    (setq num (1+ num)
      x (car p0)
      y (- y row_height)))
  ;;===============VERTICAL LINES=================;;
  (setq table_height (* (1+ rows) row_height)
    com_height (+ table_height title_height))
  (entmake
      (list '(0 . "LINE") (cons 10  p0)
        (cons 11 (list x (- (cadr p0) com_height)))))
  (entmake
      (list '(0 . "LINE") (cons 10  (list (+ x wid)(cadr p0)))
        (cons 11 (list (+ x wid) (- (cadr p0) com_height)))))
  (setq txt_xpos (cdr txt_xpos))
  (setq cnt 0)
  (repeat (length txt_xpos)
    (setq x (+ x (nth cnt txt_xpos)))
  (entmake
      (list '(0 . "LINE") (cons 10  (list x (- (cadr p0) title_height )))
        (cons 11 (list x (- (cadr p0) title_height table_height)))))
    (setq cnt (1+ cnt)
      ))
    (alert "Done")

  (princ)
)
(prompt
  "\n\t\t\t   |-----------------------------|"
)
(prompt
  "\n\t\t\t  <|  Start with PTD to execute  |>"
)
(prompt
  "\n\t\t\t   |-----------------------------|"
)
  (princ)

~'J'~

[doru10]

there is no solution to the above?
all the best

[fixo]

This will get you started, do rest your work by yourself
I have not have a time on this work

(vl-load-com)
(defun run-dialog  (leng /)
  (setq fn (strcat (getvar "dwgprefix")
     (getvar "dwgname")
     "waterparams.dcl")
 fd (open fn "w"))
  (mapcar
    (function
      (lambda (x)
 (princ x fd)
 (princ "\n" fd)
 )
      )
    (list
      "water : dialog {label=\"Parameters\";"
      "fixed_width_font=true;"
      ": edit_box{label=\"Street\";"
      "fixed_width_font=true;"
      "key = \"street\";}"
      ": edit_box{label=\"Length\";"
      "fixed_width_font=true;"
      (strcat "value=" leng ";")
      "key = \"leng\";}"
      ": list_box {label=\"Math\";"
      "fixed_width_font=true;"
      "key = \"math\";"
      "multiple_select = false;"
      "height = 3.6;"
      "allow_accept = true;"
      "}"
      ": list_box {label=\"Dia.\";"
      "fixed_width_font=true;"
      "key = \"dia\";"
      "multiple_select = false;"
      "height = 3.6;"
      "allow_accept = true;"
      "}"
      "ok_cancel;"
      "}"
      )
    )
  (close fd)
  (princ)
  )
(defun C:demo  (/
  dcl_id
  dial
  dia_list
  dia_val
  en
  ent
  fn
  leng
  math_list
  math_val
  pick)
  (vl-load-com)
  (while (setq ent (entsel "\nSelect pipe-line (or hit Enter to Exit): "))
    (if
      (member (strcase (cdr (assoc 0 (entget (car ent)))))
       (list "LWPOLYLINE" "SPLINE"))
       (progn
  (setq en (car ent))
  (setq leng (vlax-curve-getdistatparam en (vlax-curve-getendparam en)))
  (run-dialog (rtos leng 2 3))
  (if (not (setq dcl_id (load_dialog fn)))
    (exit))
  (if (not (new_dialog "water" dcl_id))
    (exit))
  (start_list "math")
  (mapcar 'add_list
   (mapcar 'vl-princ-to-string
    (setq math_list
    (list 1.05 1.1 1.15 1.2 1.25 1.3 1.35))))
  (end_list)
  (start_list "dia")
  (mapcar 'add_list
   (mapcar 'vl-princ-to-string
    (setq dia_list
    (list 12.0 24.0 36.0 48.0 60.0))))
  (end_list)
  (action_tile
    "accept"
    (strcat "(progn "
     "(setq str_val (get_tile \"street\"))"
     "(setq leng_val (get_tile \"leng\"))"
     "(setq math_val (atoi (get_tile \"math\")))"
     "(setq dia_val (atoi (get_tile \"dia\")))"
     "(done_dialog 1))")
    )
  (action_tile "cancel" "(done_dialog 0)")
  (setq pick (start_dialog))
  (unload_dialog dcl_id)
  (vl-file-delete fn)
  (if (and (= 1 pick) str_val leng_val math_val dia_val)
    (progn
      (alert
        (strcat "Street: "
         (vl-princ-to-string str_val)
         "\n"
         "Length : "
         (vl-princ-to-string (atof leng_val))
         "\n"
         "Math: "
         (vl-princ-to-string (setq mat_val (nth math_val math_list)))
         "\n"
         "Dia : "
         (vl-princ-to-string (setq dia_val (nth dia_val dia_list))))
        )
      ;;...[ rest your code goes here ]...
      )
    )
  )
      )
    )
  (princ)
  )