cadmando2 Posted April 21, 2008 Share Posted April 21, 2008 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! Quote Link to comment Share on other sites More sharing options...
Adesu Posted April 22, 2008 Share Posted April 22, 2008 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! Quote Link to comment Share on other sites More sharing options...
rkmcswain Posted April 22, 2008 Share Posted April 22, 2008 Note: Changed the thread title to make it a bit more descriptive Quote Link to comment Share on other sites More sharing options...
fixo Posted April 23, 2008 Share Posted April 23, 2008 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'~ Quote Link to comment Share on other sites More sharing options...
cadmando2 Posted April 24, 2008 Author Share Posted April 24, 2008 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" Quote Link to comment Share on other sites More sharing options...
fixo Posted April 24, 2008 Share Posted April 24, 2008 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'~ Quote Link to comment Share on other sites More sharing options...
fixo Posted April 24, 2008 Share Posted April 24, 2008 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'~ Quote Link to comment Share on other sites More sharing options...
doru10 Posted August 25, 2011 Share Posted August 25, 2011 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 versionGive 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'~ Water Network.dwg Quote Link to comment Share on other sites More sharing options...
doru10 Posted August 29, 2011 Share Posted August 29, 2011 there is no solution to the above? all the best Quote Link to comment Share on other sites More sharing options...
fixo Posted August 29, 2011 Share Posted August 29, 2011 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) ) Quote Link to comment Share on other sites More sharing options...
doru10 Posted August 30, 2011 Share Posted August 30, 2011 Thank FIXO. Sorry that I have shown much eagerness. As you have seen are in the beginning, trying to learn. ALL THE BEST. Quote Link to comment Share on other sites More sharing options...
fixo Posted August 30, 2011 Share Posted August 30, 2011 Glad to help Cheers Quote Link to comment Share on other sites More sharing options...
doru10 Posted November 4, 2011 Share Posted November 4, 2011 Mr. Fixo, I tried to finish your lisp. I failed. It seems to learn the programming language I need some time and perfect understanding of system variables. If you can finish (please), will remain Grateful. Sincerely, Quote Link to comment Share on other sites More sharing options...
fixo Posted November 4, 2011 Share Posted November 4, 2011 Mr. Fixo,I tried to finish your lisp. I failed. It seems to learn the programming language I need some time and perfect understanding of system variables. If you can finish (please), will remain Grateful. Sincerely, I wiil be try do finish this code tomorrow , not sure about my free time Quote Link to comment Share on other sites More sharing options...
fixo Posted November 5, 2011 Share Posted November 5, 2011 Try again ;; local defuns (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=" (rtos leng 2 3) ";") "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) ) ;; convert radians to degrees (defun rtd (rad) (/ (* rad 180) pi) ) ;; main part (defun C:PPW (/ *error* ang cl cr curve dcl_id dia dia_list dia_val en ent fn fst info leng leng_val lpt lpt1 lpt2 mat math_list math_val mat_val osm pick pt snd str_val txh txst upt) (vl-load-com) (defun *error* (msg) (if msg(princ msg)) ;; stop any command (while (/= (getvar "cmdactive") 0) (command)) ;;restore variables (if osm (setvar "osmode" osm)) (if cl (setvar "clayer" cl)) (if cr (setvar "cecolor" cr)) (if txst (setvar "textstyle" txst)) (if txh (setvar "textsize" txh)) (command "._undo" "E") ) (setq osm (getvar "osmode")) (setq cl (getvar "clayer")) (setq cr (getvar "cecolor")) (setq txst (getvar "textstyle")) (setq txh(getvar "textsize")) (command "._undo" "BE") (setvar "osmode" 0) (setvar "textsize" 50.0) (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 curve (vlax-ename->vla-object en)) (setq pt (vlax-curve-getclosestpointto en (cadr ent))) (setq leng (vlax-curve-getdistatparam en (vlax-curve-getendparam en))) (run-dialog leng ) (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 "AB" "CD" "EF" "GH")))) (end_list) (start_list "dia") (mapcar 'add_list (mapcar 'vl-princ-to-string (setq dia_list (list 100 200 300 400 500)))) (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 (setq fst (vl-princ-to-string str_val)) (setq snd (rtos (atof leng_val)2 3)) (setq mat (vl-princ-to-string (setq mat_val (nth math_val math_list)))) (setq dia(vl-princ-to-string (setq dia_val (nth dia_val dia_list)))) (setq ang (angle '(0 0 0) (trans (vlax-curve-getfirstderiv curve (vlax-curve-getparamatpoint curve pt) ) 0 1 t ) ) ) (setq label (strcat "%<[url="file://\\AcObjProp"]\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] " (itoa (vla-get-objectid curve)) ">%).Length [url="file://\\f"]\\f[/url] \"%lu2%pr3\">%" ) ) ;;set text rotation angle to more readable: (if (< (/ pi 2) ang (* pi 1.5)) (setq ang (+ ang pi)) ) (setq upt (polar pt (+ ang (/ pi 2)) (* (getvar "textsize") 1.5))) (setq lpt (polar pt (- ang (/ pi 2)) (* (getvar "textsize") 1.5))) (setq lpt1 (polar lpt (+ ang pi) (getvar "textsize"))) (setq lpt2 (polar lpt ang (getvar "textsize"))) (setq ang (rtd ang)) (setvar "cecolor" "bylayer") (setvar "clayer" "1 Street") (command "-mtext" "_non" upt "J" "MC" "H" 50.0 "R" ang "w" 0 fst "") (setvar "clayer" "2 Length") (command "-mtext" "_non" pt "J" "MC" "H" 50.0 "R" ang "w" 0 label "") (setvar "clayer" "3 Mat") (command "-mtext" "_non" lpt1 "J" "MR" "H" 50.0 "R" ang "w" 0 mat "") (setvar "clayer" "4 Dia") (command "-mtext" "_non" lpt2 "J" "ML" "H" 50.0 "R" ang "w" 0 (strcat "%%c" dia) "") ) ) ) ) ) (*error* nil) (princ) ) (princ "\n Start command with PPW") (prin1) Quote Link to comment Share on other sites More sharing options...
doru10 Posted November 7, 2011 Share Posted November 7, 2011 Thanks a lot. I overcome the problem. l do not understand VL-.... , VLA-....,VlAX-....., Thank you, you are a true guru. respectfully Try again ;; local defuns (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=" (rtos leng 2 3) ";") "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) ) ;; convert radians to degrees (defun rtd (rad) (/ (* rad 180) pi) ) ;; main part (defun C:PPW (/ *error* ang cl cr curve dcl_id dia dia_list dia_val en ent fn fst info leng leng_val lpt lpt1 lpt2 mat math_list math_val mat_val osm pick pt snd str_val txh txst upt) (vl-load-com) (defun *error* (msg) (if msg(princ msg)) ;; stop any command (while (/= (getvar "cmdactive") 0) (command)) ;;restore variables (if osm (setvar "osmode" osm)) (if cl (setvar "clayer" cl)) (if cr (setvar "cecolor" cr)) (if txst (setvar "textstyle" txst)) (if txh (setvar "textsize" txh)) (command "._undo" "E") ) (setq osm (getvar "osmode")) (setq cl (getvar "clayer")) (setq cr (getvar "cecolor")) (setq txst (getvar "textstyle")) (setq txh(getvar "textsize")) (command "._undo" "BE") (setvar "osmode" 0) (setvar "textsize" 50.0) (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 curve (vlax-ename->vla-object en)) (setq pt (vlax-curve-getclosestpointto en (cadr ent))) (setq leng (vlax-curve-getdistatparam en (vlax-curve-getendparam en))) (run-dialog leng ) (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 "AB" "CD" "EF" "GH")))) (end_list) (start_list "dia") (mapcar 'add_list (mapcar 'vl-princ-to-string (setq dia_list (list 100 200 300 400 500)))) (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 (setq fst (vl-princ-to-string str_val)) (setq snd (rtos (atof leng_val)2 3)) (setq mat (vl-princ-to-string (setq mat_val (nth math_val math_list)))) (setq dia(vl-princ-to-string (setq dia_val (nth dia_val dia_list)))) (setq ang (angle '(0 0 0) (trans (vlax-curve-getfirstderiv curve (vlax-curve-getparamatpoint curve pt) ) 0 1 t ) ) ) (setq label (strcat "%<[url="file://\\AcObjProp"]\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] " (itoa (vla-get-objectid curve)) ">%).Length [url="file://\\f"]\\f[/url] \"%lu2%pr3\">%" ) ) ;;set text rotation angle to more readable: (if (< (/ pi 2) ang (* pi 1.5)) (setq ang (+ ang pi)) ) (setq upt (polar pt (+ ang (/ pi 2)) (* (getvar "textsize") 1.5))) (setq lpt (polar pt (- ang (/ pi 2)) (* (getvar "textsize") 1.5))) (setq lpt1 (polar lpt (+ ang pi) (getvar "textsize"))) (setq lpt2 (polar lpt ang (getvar "textsize"))) (setq ang (rtd ang)) (setvar "cecolor" "bylayer") (setvar "clayer" "1 Street") (command "-mtext" "_non" upt "J" "MC" "H" 50.0 "R" ang "w" 0 fst "") (setvar "clayer" "2 Length") (command "-mtext" "_non" pt "J" "MC" "H" 50.0 "R" ang "w" 0 label "") (setvar "clayer" "3 Mat") (command "-mtext" "_non" lpt1 "J" "MR" "H" 50.0 "R" ang "w" 0 mat "") (setvar "clayer" "4 Dia") (command "-mtext" "_non" lpt2 "J" "ML" "H" 50.0 "R" ang "w" 0 (strcat "%%c" dia) "") ) ) ) ) ) (*error* nil) (princ) ) (princ "\n Start command with PPW") (prin1) Quote Link to comment Share on other sites More sharing options...
fixo Posted November 7, 2011 Share Posted November 7, 2011 Hey, buddy Do not force me to turn red, I only the usual hacker Though, you're welcome, I'm glad if this routine will help with your work ~'J'~ Quote Link to comment Share on other sites More sharing options...
Tankman Posted November 9, 2011 Share Posted November 9, 2011 Perhaps not exactly what you're looking for but, might help. LTFly Instructions.zip Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.