+ Reply to Thread
Page 1 of 2 1 2 LastLast
Results 1 to 10 of 18
  1. #1
    Senior Member
    Computer Details
    cadmando2's Computer Details
    Operating System:
    Windows 7
    Using
    AutoCAD 2014
    Join Date
    Aug 2007
    Posts
    146

    Default polyLine with Entities attached?

    Registered forum members do not see this ad.

    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
    Last edited by cadmando2; 22nd Apr 2008 at 08:04 pm.

  2. #2
    Senior Member Adesu's Avatar
    Using
    AutoCAD 2005
    Join Date
    Feb 2004
    Location
    Indonesia-Tangerang
    Posts
    158

    Default

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

    Quote Originally Posted by cadmando2 View Post
    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!

  3. #3
    Super Moderator rkmcswain's Avatar
    Computer Details
    rkmcswain's Computer Details
    Operating System:
    Windows 7 Pro x64
    Motherboard:
    Intel DZ77RE-75K
    CPU:
    i7-4770K 3.50GHz
    RAM:
    32GB
    Graphics:
    Nvidia Quadro 2000
    Primary Storage:
    125GB SSD
    Secondary Storage:
    500GB SATA
    Monitor:
    ASUS 27" / ASUS 24"
    Discipline
    Civil
    Using
    Civil 3D 2015
    Join Date
    Sep 2005
    Location
    Houston
    Posts
    3,932

    Default

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

  4. #4
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Thanks God, I'm far enough from Hitleropa
    Posts
    1,697

    Default

    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

    Code:
    ;; 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'~
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

  5. #5
    Senior Member
    Computer Details
    cadmando2's Computer Details
    Operating System:
    Windows 7
    Using
    AutoCAD 2014
    Join Date
    Aug 2007
    Posts
    146

    Default

    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"

  6. #6
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Thanks God, I'm far enough from Hitleropa
    Posts
    1,697

    Default

    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'~
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

  7. #7
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Thanks God, I'm far enough from Hitleropa
    Posts
    1,697

    Default

    Quote Originally Posted by cadmando2 View Post
    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

    Code:
    ;; 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'~
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

  8. #8
    Junior Member
    Using
    AutoCAD 2008
    Join Date
    Jun 2010
    Posts
    22

    Default beautiful lisp

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




    Quote Originally Posted by fixo View Post
    Okay, I have to rewrote it for your version
    Give this a try

    Code:
    ;; 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'~
    Attached Files

  9. #9
    Junior Member
    Using
    AutoCAD 2008
    Join Date
    Jun 2010
    Posts
    22

    Default

    there is no solution to the above?
    all the best

  10. #10
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Thanks God, I'm far enough from Hitleropa
    Posts
    1,697

    Default

    Registered forum members do not see this ad.

    This will get you started, do rest your work by yourself
    I have not have a time on this work
    Code:
    (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)
      )
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

Similar Threads

  1. align sequentional numirec text on polyline
    By motee-z in forum AutoLISP, Visual LISP & DCL
    Replies: 23
    Last Post: 26th Jan 2007, 07:22 pm
  2. Custom Polyline
    By CADbadger in forum AutoCAD General
    Replies: 8
    Last Post: 28th Aug 2006, 03:24 am
  3. can text be changed to a polyline?
    By Raider in forum AutoCAD General
    Replies: 6
    Last Post: 5th Jul 2006, 11:21 am
  4. align text along polyline
    By wisper in forum AutoCAD General
    Replies: 6
    Last Post: 2nd May 2006, 12:34 pm
  5. Text along Polyline
    By owy123 in forum AutoCAD Drawing Management & Output
    Replies: 2
    Last Post: 1st Jul 2005, 04:13 am

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts