Zykl0 Posted October 18, 2008 Share Posted October 18, 2008 Hi! What i am looking for is very particular and might be pretty hard to code from scratch. But i hope someone has already encountered this situation and get some code hidden somewhere . -Il start with explaining the plans i am working on it. I have dozens of fire protection piping (sprinkler) to dimension using a prehistoric tool. The tool work like this. i have multiple button and they only differ in pipe diameter. eg: when i click on 2" then i click on a pipe point-A to point-B the tool put the lenght of the line under the line and the diameter above (the diameter is set by me depending the button i press) Here's the deal, dimensioning a single floor like this take 2 day and im about to shoot myself this is so brainless. -The Challenge -I have 2 diameter on every floor the main pipe and the line, the two layers are set to M-N-FP-DIS and M-N-FP-MAIN -I want to be able to cross window my floor and the routine will auto dimension every single line set to these 2 layers. actually i dont know if i should use a dynamic block with dimension inside or just putting text under and above the line. -The text above the line must be set to layer M-N-FP-DIS-DIA and under M-N-FP-DIS-LIN for the line (M-N-FP-DIS) and M-N-FP-MAIN-DIA and under M-N-FP-MAIN-LIN for the main. Main are 2" Line are 1" Please help me to get this task automated Quote Link to comment Share on other sites More sharing options...
CAB Posted October 18, 2008 Share Posted October 18, 2008 Quick and dirty, no warranty. ; CAB 10.18.08 version 1.0 (defun c:LabelPipe (/ index ss obj lyr ept spt mpt mpt1 mpt2 txtht len) (defun maketext (pt ang str ht just lay / dxf72 dxf73) ;;(setq dxf72 (cdr (assoc just '(("TC" . 1 )("BC" . 1 ))))) (setq dxf73 (cdr (assoc just '(("TC" . 3) ("BC" . 1))))) (entmakex (list (cons 0 "TEXT") ;*** (cons 1 str) ; (the string itself) (cons 6 "BYLAYER") ; Linetype name (cons 7 "STANDARD") ;* Text style name, defaults to STANDARD, not current (cons 8 lay) ; layer (cons 10 pt) ;* First alignment point (in OCS) (cons 11 pt) ;* Second alignment point (in OCS) ;;(cons 39 0.0) ; Thickness (optional; default = 0) (cons 40 ht) ;* Text height ;;(cons 41 1.0) ; Relative X scale factor, Width Factor, defaults to 1.0 (cons 50 ang) ; Text rotation ange ;;(cons 51 0.0) ; Oblique angle (cons 71 0) ; Text generation flags (cons 72 1) ; Horizontal text justification type (cons 73 dxf73) ; Vertical text justification type ) ) ) (setq index -1) (if (zerop (setq txtht (getvar 'textsize))) (setq txtht 5) ) (prompt "\nSelect pipe to label.") (if (setq ss (ssget '((0 . "LINE") (8 . "M-N-FP-DIS,M-N-FP-MAIN")))) (progn (while (< (setq index (1+ index)) (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss index)) lyr (vla-get-layer obj) ept (vlax-get obj 'endpoint) spt (vlax-get obj 'startpoint) ang (angle spt ept) mpt (polar ept (angle ept spt) (/ (distance ept spt) 2.0)) len (vlax-get obj 'length) ) (if (and (> ang (* 0.5 pi)) (<= ang (* 1.5 pi))) (setq ang (+ ang pi)) ) (setq mpt1 (polar mpt (+ ang (/ pi 2.0)) (* (getvar 'dimscale) (getvar 'dimgap))) mpt2 (polar mpt (+ ang (* pi 1.5)) (* (getvar 'dimscale) (getvar 'dimgap))) ) (cond ((= lyr "M-N-FP-MAIN") (maketext mpt1 ang "2\"" txtht "BC" "M-N-FP-MAIN-DIA") (maketext mpt2 ang (rtos len) txtht "TC" "M-N-FP-MAIN-LIN") ) ((= lyr "M-N-FP-DIS") (maketext mpt1 ang "1\"" txtht "BC" "M-N-FP-DIS-DIA") (maketext mpt2 ang (rtos len) txtht "TC" "M-N-FP-DIS-LIN") ) ) ) ) ) (princ) ) (prompt "\nLabel pipe lisp loaded, Enter labelPipe to run.") (princ) Quote Link to comment Share on other sites More sharing options...
Zykl0 Posted October 19, 2008 Author Share Posted October 19, 2008 WOW i'm amazed this work like a charm ... i tried many drawing possibility also in metric/imperial format and everything seem very solid. I dont really understand your source code maybe 20% i never really coded in lisp, i only edited some routine here and there to fit my needs. but this one will save my ass thank you very much! i noticed the height of the text is linked to the dimstyle i am using this is a major plus. and the text that fit any angle of the line. one little thing. how do i set the number of trailing zero and the rounded number? I am planning to adapt this code to metric and imperial template and i would like in imperial the number will be rounded to 1/4" and in metric to 5mm I suspect this has something to do with the (rtos len) of the code but i cant find the syntax and variable used with this function in the autocad helpfile Thank you again you made my day! (maybe month!) Quote Link to comment Share on other sites More sharing options...
CAB Posted October 19, 2008 Share Posted October 19, 2008 Gald it worked for you. Here is the info on rtos. (rtos number [mode [precision]]) The rtos function returns a string that is the representation of number according to the settings of mode, precision, and the system variables UNITMODE, DIMZIN, LUNITS, and LUPREC. Arguments number A number. mode An integer specifying the linear units mode. The mode corresponds to the values allowed for the AutoCAD system variable lunits and can be one of the following numbers: 1 Scientific 2 Decimal 3 Engineering (feet and decimal inches) 4 Architectural (feet and fractional inches) 5 Fractional precision An integer specifying the precision. Quote Link to comment Share on other sites More sharing options...
CAB Posted October 19, 2008 Share Posted October 19, 2008 The text size could be a problem as it uses the current setting: (setq txtht (getvar 'textsize))) I did not need the zerop test as textsize is never zero. There need to be some more code to assure a proper text size. Do you have a default size you want? Do you use a particular style besides STANDARD? Quote Link to comment Share on other sites More sharing options...
Zykl0 Posted October 19, 2008 Author Share Posted October 19, 2008 Ok i have found that (maketext mpt2 ang (rtos len 4 2) txtht "TC" "M-N-FP-MAIN-LIN") Work like a charm it round of my dimension to 1/4" But i cant figure how to round it to 5mm in metric format Yes in both template metric/imperial i have one style of text called Royal (7 1/2" in imperial & 200mm on the metric one) i also have many dimstyle -Imperial- Royal 24, Royal 48, Royal 96 -Metric- Royal 20, Royal 50, Royal 100 They are all pre-set to 1:100 / 1/8" = 1'- 0" 95% of my viewport ar set to these. but i have no problem using your routine in both template the height of the text is ok. Quote Link to comment Share on other sites More sharing options...
CAB Posted October 19, 2008 Share Posted October 19, 2008 I'm too tired to test this. It's midnight here, off to bed. ; CAB 10.19.08 version 1.2 (defun c:LabelPipe (/ index ss obj lyr ept spt mpt mpt1 mpt2 txtht len len$ lst dUnits txtoffset MainSize DistSize maketext kdub:roundNearest GetUnits) (defun maketext (pt ang str ht just lay sty / dxf72 dxf73) ;;(setq dxf72 (cdr (assoc just '(("TC" . 1 )("BC" . 1 ))))) (setq dxf73 (cdr (assoc just '(("TC" . 3) ("BC" . 1))))) (entmakex (list (cons 0 "TEXT") (cons 1 str) ; (the string itself) (cons 6 "BYLAYER") ; Linetype name (cons 7 sty) ;* Text style name, defaults to STANDARD, not current (cons 8 lay) ; layer (cons 10 pt) ;* First alignment point (in OCS) (cons 11 pt) ;* Second alignment point (in OCS) ;;(cons 39 0.0) ; Thickness (optional; default = 0) (cons 40 ht) ;* Text height ;;(cons 41 1.0) ; Relative X scale factor, Width Factor, defaults to 1.0 (cons 50 ang) ; Text rotation ange ;;(cons 51 0.0) ; Oblique angle (cons 71 0) ; Text generation flags (cons 72 1) ; Horizontal text justification type (cons 73 dxf73) ; Vertical text justification type ) ) ) ;;* kdub:roundNearest (numVal roundTo displayPrecision) ;; Round a numeric positive number to the NEAREST 'rounded' number ;; and format to n digits ;; kwb@theSwamp 20070814 (DEFUN kdub:roundNearest (numVal roundTo displayPrecision / remNum) (SETQ remNum (REM numVal roundTo)) (RTOS (IF (>= (* 2 remNum) roundTo) (+ numVal (- roundTo remNum)) (- numVal remNum) ) 2 displayPrecision ) ) ;; Returns the type of units (defun GetUnits (/ Units) (setq Units (getvar "InsUnits")) ; DesignCenter Drag Units (cond ((= Units 0) ;NoUnit (if (= (getvar "MEASUREINIT") 1) ; if metric "mm" ; use Millimeter "inch" ; else Inch ) ) (t (nth (1- Units) (list "inch" ;Inch "feet" ;Feet "mile" ;Mile "mm" ;Millimeter "cm" ;Centimeter "m" ;Meter "km" ;Kilometer "microinch" ;Micro inch "mil" ;Milli inch "yard" ;Yard "angstrom" ;Angstrom "nm" ;Nanometer "micron" ;Micron "dm" ;Decimeter "dam" ;Decameter "hm" ;Hectometer "gm" ;Gigameter "au" ;Astronomic unit "light_year" ;Light year "parsec" ;Parsec ) ) ) ) ) ;; use Royal Text Style if it exist (if (setq lst (tblsearch "style" "ROYAL")) (setq sty "ROYAL" txtht (cdr (assoc 40 lst))) ;; else use current text height (setq sty "STANDARD" txtht (getvar 'textsize)) ) (setq dUnits (strcat " "(GetUnits))) (if (or (vl-position (getvar "InsUnits") '(4 5 6 7 12 14 15 16 17)) (= (getvar "MEASUREINIT") 1) ; if metric ) ;; Metric Units (setq txtoffset (* (getvar 'dimscale) (getvar 'dimgap)) MainSize (strcat "50" dUnits) DistSize (strcat "10" dUnits) ) ;; English Units (setq txtoffset (* (getvar 'dimscale) (getvar 'dimgap)) MainSize "2\"" DistSize "1\"" ) ) (setq index -1) (prompt "\nSelect pipes to label.") (if (setq ss (ssget '((0 . "LINE") (8 . "M-N-FP-DIS,M-N-FP-MAIN")))) (progn (command "._Undo" "_begin") (while (< (setq index (1+ index)) (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss index)) lyr (vla-get-layer obj) ept (vlax-get obj 'endpoint) spt (vlax-get obj 'startpoint) ang (angle spt ept) mpt (polar ept (angle ept spt) (/ (distance ept spt) 2.0)) len (vlax-get obj 'length) ) (if (and (> ang (* 0.5 pi)) (<= ang (* 1.5 pi))) (setq ang (+ ang pi)) ) ;; text offset from pipe (setq mpt1 (polar mpt (+ ang (/ pi 2.0)) txtoffset) mpt2 (polar mpt (+ ang (* pi 1.5)) txtoffset) ) ;; adjust for Metric units rounded to 5 & 0 decimal points ;; or English Units rounded to 1/4 (if (or (vl-position (getvar "InsUnits") '(4 5 6 7 12 14 15 16 17)) (= (getvar "MEASUREINIT") 1) ; if metric ) (setq len$ (strcat (kdub:roundNearest len 5 0) dUnits)) ; use Millimeter 05 (setq len$ (rtos len 4 2)) ; else Inch & 0.00 ) (cond ((= lyr "M-N-FP-MAIN") (maketext mpt1 ang MainSize txtht "BC" "M-N-FP-MAIN-DIA" sty) (maketext mpt2 ang len$ txtht "TC" "M-N-FP-MAIN-LIN" sty) ) ((= lyr "M-N-FP-DIS") (maketext mpt1 ang DistSize txtht "BC" "M-N-FP-DIS-DIA" sty) (maketext mpt2 ang len$ txtht "TC" "M-N-FP-DIS-LIN" sty) ) ) ) (command "._Undo" "_end") ) ) (princ) ) (prompt "\nLabel pipe lisp loaded, Enter LabelPipe to run.") (princ) Quote Link to comment Share on other sites More sharing options...
Zykl0 Posted October 19, 2008 Author Share Posted October 19, 2008 No its not working. Whenever i set my Measureinit = 1 (metric or imp template) I'm getting an error like this. Select objects: ; error: bad argument type: numberp: "50" Select objects: ; error: bad argument type: numberp: "1220" If i set Measureinit = 0 i can label in imperial template but the metric one doesn't want to work. Two questions. -Is the Measureinit really a viable way? because whenever i switch to different template the measureinit is not ajusting his variable with the template, but measurement variable seem to follow the template is it a better alternative? -where do you set the text offset from line? i cant figure it out. Thanks n good night Quote Link to comment Share on other sites More sharing options...
CAB Posted October 19, 2008 Share Posted October 19, 2008 I updated the code above, give it a try. Modified it again anticipating the need for pipe size change in metric version. Quote Link to comment Share on other sites More sharing options...
Zykl0 Posted October 19, 2008 Author Share Posted October 19, 2008 Everything is working good except 2 things. In the first version you made the pipe label text height was listening the dimscale factor. But now if i change dimscale the label text always stay at same height unless i manually change the height of the text I have NO idea how the text offset work. let say i label a plan in english unit using a dimscale factor of 96 the label text offset is verry far from the line, around 150% the text height above/under and inside a metric plan the label text offset is much perfect, the gap between the line and label is 50% my text height. Question; Is it possible to set the "label text height" using this formula Label textheight = txtstyle in use * dimscale factor and also the gap between line and text like this; Label textheight = txtstyle in use * dimscale factor / 2 Quote Link to comment Share on other sites More sharing options...
CAB Posted October 19, 2008 Share Posted October 19, 2008 Question; Is it possible to set the "label text height" using this formula Label textheight = txtstyle in use * dimscale factor and also the gap between line and text like this; Label textheight = txtstyle in use * dimscale factor / 2 This does not work Text ht 7" times dimscale 96 = 672 text height Text ht 7" times [96/2] = 336 text gap Quote Link to comment Share on other sites More sharing options...
CAB Posted October 19, 2008 Share Posted October 19, 2008 Give this a try: Text height is calc'ed on line 86 or 92 Text Gap is calc'ed on line 102 or 107 & is 1/2 of the text height ; CAB 10.19.08 version 1.3 (defun c:LabelPipe (/ index ss obj lyr ept spt mpt mpt1 mpt2 txtht len len$ lst dUnits txtoffset MainSize DistSize maketext kdub:roundNearest GetUnits) (defun maketext (pt ang str ht just lay sty / dxf72 dxf73) ;;(setq dxf72 (cdr (assoc just '(("TC" . 1 )("BC" . 1 ))))) (setq dxf73 (cdr (assoc just '(("TC" . 3) ("BC" . 1))))) (entmakex (list (cons 0 "TEXT") (cons 1 str) ; (the string itself) (cons 6 "BYLAYER") ; Linetype name (cons 7 sty) ;* Text style name, defaults to STANDARD, not current (cons 8 lay) ; layer (cons 10 pt) ;* First alignment point (in OCS) (cons 11 pt) ;* Second alignment point (in OCS) ;;(cons 39 0.0) ; Thickness (optional; default = 0) (cons 40 ht) ;* Text height ;;(cons 41 1.0) ; Relative X scale factor, Width Factor, defaults to 1.0 (cons 50 ang) ; Text rotation ange ;;(cons 51 0.0) ; Oblique angle (cons 71 0) ; Text generation flags (cons 72 1) ; Horizontal text justification type (cons 73 dxf73) ; Vertical text justification type ) ) ) ;;* kdub:roundNearest (numVal roundTo displayPrecision) ;; Round a numeric positive number to the NEAREST 'rounded' number ;; and format to n digits ;; kwb@theSwamp 20070814 (DEFUN kdub:roundNearest (numVal roundTo displayPrecision / remNum) (SETQ remNum (REM numVal roundTo)) (RTOS (IF (>= (* 2 remNum) roundTo) (+ numVal (- roundTo remNum)) (- numVal remNum) ) 2 displayPrecision ) ) ;; Returns the type of units (defun GetUnits (/ Units) (setq Units (getvar "InsUnits")) ; DesignCenter Drag Units (cond ((= Units 0) ;NoUnit (if (= (getvar "MEASUREINIT") 1) ; if metric "mm" ; use Millimeter "inch" ; else Inch ) ) (t (nth (1- Units) (list "inch" ;Inch "feet" ;Feet "mile" ;Mile "mm" ;Millimeter "cm" ;Centimeter "m" ;Meter "km" ;Kilometer "microinch" ;Micro inch "mil" ;Milli inch "yard" ;Yard "angstrom" ;Angstrom "nm" ;Nanometer "micron" ;Micron "dm" ;Decimeter "dam" ;Decameter "hm" ;Hectometer "gm" ;Gigameter "au" ;Astronomic unit "light_year" ;Light year "parsec" ;Parsec ) ) ) ) ) ;; use Royal Text Style if it exist (if (setq lst (tblsearch "style" "ROYAL")) (setq sty "ROYAL" txtht (cdr (assoc 40 lst)) ; calc the text height txtht (if (zerop txtht)(* (getvar "dimscale") 0.09375)txtht) ; correct for 0 ) ;; else use current text height (setq sty "STANDARD" ;;txtht (getvar 'textsize) ; calc the text height txtht (* (getvar "dimscale") 0.09375) ; calc the text height ) ) (setq dUnits (strcat " "(GetUnits))) (if (or (vl-position (getvar "InsUnits") '(4 5 6 7 12 14 15 16 17)) (= (getvar "MEASUREINIT") 1) ; if metric ) ;; Metric Units (setq txtoffset (/ txtht 2.0) ; text offset from line MainSize (strcat "50" dUnits) DistSize (strcat "10" dUnits) ) ;; English Units (setq txtoffset (/ txtht 2.0) ; text offset from line MainSize "2\"" DistSize "1\"" ) ) (setq index -1) (prompt "\nSelect pipes to label.") (if (setq ss (ssget '((0 . "LINE") (8 . "M-N-FP-DIS,M-N-FP-MAIN")))) (progn (command "._Undo" "_begin") (while (< (setq index (1+ index)) (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss index)) lyr (vla-get-layer obj) ept (vlax-get obj 'endpoint) spt (vlax-get obj 'startpoint) ang (angle spt ept) mpt (polar ept (angle ept spt) (/ (distance ept spt) 2.0)) len (vlax-get obj 'length) ) (if (and (> ang (* 0.5 pi)) (<= ang (* 1.5 pi))) (setq ang (+ ang pi)) ) ;; text offset from pipe (setq mpt1 (polar mpt (+ ang (/ pi 2.0)) txtoffset) mpt2 (polar mpt (+ ang (* pi 1.5)) txtoffset) ) ;; adjust for Metric units rounded to 5 & 0 decimal points ;; or English Units rounded to 1/4 (if (or (vl-position (getvar "InsUnits") '(4 5 6 7 12 14 15 16 17)) (= (getvar "MEASUREINIT") 1) ; if metric ) (setq len$ (strcat (kdub:roundNearest len 5 0) dUnits)) ; use Millimeter 05 (setq len$ (rtos len 4 2)) ; else Inch & 0.00 ) (cond ((= lyr "M-N-FP-MAIN") (maketext mpt1 ang MainSize txtht "BC" "M-N-FP-MAIN-DIA" sty) (maketext mpt2 ang len$ txtht "TC" "M-N-FP-MAIN-LIN" sty) ) ((= lyr "M-N-FP-DIS") (maketext mpt1 ang DistSize txtht "BC" "M-N-FP-DIS-DIA" sty) (maketext mpt2 ang len$ txtht "TC" "M-N-FP-DIS-LIN" sty) ) ) ) (command "._Undo" "_end") ) ) (princ) ) (prompt "\nLabel pipe lisp loaded, Enter LabelPipe to run.") (princ) Quote Link to comment Share on other sites More sharing options...
Zykl0 Posted October 23, 2008 Author Share Posted October 23, 2008 Works like a charm! I'm trying to adapt it for many situation i encounter at job atm. I would like to learn LISP, i'm trying now i can output a "Hello world" From the code above. when i label cpvc pipe i dont need to be precisly on every lenght of pipe. many of them will be benched on place at the job installation. Very small pipe lenght.. smaller than 305mm (or 12") can be ignored because anyways on small pipe like this if i label them all the text is overlaping each other. in the code i would like to put something like (setq index -1) (prompt "\nSelect pipes to label.") (if (setq ss (ssget '((0 . "LINE" [b][color=Red]>305mm or 12"[/color][/b]) (8 . "M-N-FP-DIS,M-N-FP-MAIN")))) (progn (command "._Undo" "_begin") this is not the right place to put the condition can you give me a hint so i could do it myself (sorry for bad grammar english is not my spoken language) Quote Link to comment Share on other sites More sharing options...
CAB Posted October 23, 2008 Share Posted October 23, 2008 Glad it worked. Try this revision, I didn't test. See new variable MinLen ;; CAB 10.23.08 version 1.4 ;; added skip of length too short for sizing (defun c:LabelPipe (/ index ss obj lyr ept spt mpt mpt1 mpt2 txtht len len$ lst dUnits MinLen txtoffset MainSize DistSize maketext kdub:roundNearest GetUnits) (defun maketext (pt ang str ht just lay sty / dxf72 dxf73) ;;(setq dxf72 (cdr (assoc just '(("TC" . 1 )("BC" . 1 ))))) (setq dxf73 (cdr (assoc just '(("TC" . 3) ("BC" . 1))))) (entmakex (list (cons 0 "TEXT") (cons 1 str) ; (the string itself) (cons 6 "BYLAYER") ; Linetype name (cons 7 sty) ;* Text style name, defaults to STANDARD, not current (cons 8 lay) ; layer (cons 10 pt) ;* First alignment point (in OCS) (cons 11 pt) ;* Second alignment point (in OCS) ;;(cons 39 0.0) ; Thickness (optional; default = 0) (cons 40 ht) ;* Text height ;;(cons 41 1.0) ; Relative X scale factor, Width Factor, defaults to 1.0 (cons 50 ang) ; Text rotation ange ;;(cons 51 0.0) ; Oblique angle (cons 71 0) ; Text generation flags (cons 72 1) ; Horizontal text justification type (cons 73 dxf73) ; Vertical text justification type ) ) ) ;;* kdub:roundNearest (numVal roundTo displayPrecision) ;; Round a numeric positive number to the NEAREST 'rounded' number ;; and format to n digits ;; kwb@theSwamp 20070814 (DEFUN kdub:roundNearest (numVal roundTo displayPrecision / remNum) (SETQ remNum (REM numVal roundTo)) (RTOS (IF (>= (* 2 remNum) roundTo) (+ numVal (- roundTo remNum)) (- numVal remNum) ) 2 displayPrecision ) ) ;; Returns the type of units (defun GetUnits (/ Units) (setq Units (getvar "InsUnits")) ; DesignCenter Drag Units (cond ((= Units 0) ;NoUnit (if (= (getvar "MEASUREINIT") 1) ; if metric "mm" ; use Millimeter "inch" ; else Inch ) ) (t (nth (1- Units) (list "inch" ;Inch "feet" ;Feet "mile" ;Mile "mm" ;Millimeter "cm" ;Centimeter "m" ;Meter "km" ;Kilometer "microinch" ;Micro inch "mil" ;Milli inch "yard" ;Yard "angstrom" ;Angstrom "nm" ;Nanometer "micron" ;Micron "dm" ;Decimeter "dam" ;Decameter "hm" ;Hectometer "gm" ;Gigameter "au" ;Astronomic unit "light_year" ;Light year "parsec" ;Parsec ) ) ) ) ) ;; use Royal Text Style if it exist (if (setq lst (tblsearch "style" "ROYAL")) (setq sty "ROYAL" txtht (cdr (assoc 40 lst)) ; calc the text height txtht (if (zerop txtht)(* (getvar "dimscale") 0.09375)txtht) ; correct for 0 ) ;; else use current text height (setq sty "STANDARD" ;;txtht (getvar 'textsize) ; calc the text height txtht (* (getvar "dimscale") 0.09375) ; calc the text height ) ) (setq dUnits (strcat " "(GetUnits))) (if (or (vl-position (getvar "InsUnits") '(4 5 6 7 12 14 15 16 17)) (= (getvar "MEASUREINIT") 1) ; if metric ) ;; Metric Units (setq txtoffset (/ txtht 2.0) ; text offset from line MainSize (strcat "50" dUnits) DistSize (strcat "10" dUnits) MinLen 305 ; Min Length to add text ) ;; English Units (setq txtoffset (/ txtht 2.0) ; text offset from line MainSize "2\"" DistSize "1\"" MinLen 12 ; Min Length to add text ) ) (setq index -1) (prompt "\nSelect pipes to label.") (if (setq ss (ssget '((0 . "LINE") (8 . "M-N-FP-DIS,M-N-FP-MAIN")))) (progn (command "._Undo" "_begin") (while (< (setq index (1+ index)) (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss index)) lyr (vla-get-layer obj) ept (vlax-get obj 'endpoint) spt (vlax-get obj 'startpoint) ang (angle spt ept) mpt (polar ept (angle ept spt) (/ (distance ept spt) 2.0)) len (vlax-get obj 'length) ) (if (> len MinLen) (progn (if (and (> ang (* 0.5 pi)) (<= ang (* 1.5 pi))) (setq ang (+ ang pi)) ) ;; text offset from pipe (setq mpt1 (polar mpt (+ ang (/ pi 2.0)) txtoffset) mpt2 (polar mpt (+ ang (* pi 1.5)) txtoffset) ) ;; adjust for Metric units rounded to 5 & 0 decimal points ;; or English Units rounded to 1/4 (if (or (vl-position (getvar "InsUnits") '(4 5 6 7 12 14 15 16 17)) (= (getvar "MEASUREINIT") 1) ; if metric ) (setq len$ (strcat (kdub:roundNearest len 5 0) dUnits)) ; use Millimeter 05 (setq len$ (rtos len 4 2)) ; else Inch & 0.00 ) (cond ((= lyr "M-N-FP-MAIN") (maketext mpt1 ang MainSize txtht "BC" "M-N-FP-MAIN-DIA" sty) (maketext mpt2 ang len$ txtht "TC" "M-N-FP-MAIN-LIN" sty) ) ((= lyr "M-N-FP-DIS") (maketext mpt1 ang DistSize txtht "BC" "M-N-FP-DIS-DIA" sty) (maketext mpt2 ang len$ txtht "TC" "M-N-FP-DIS-LIN" sty) ) ) )) ) (command "._Undo" "_end") ) ) (princ) ) (prompt "\nLabel pipe lisp loaded, Enter LabelPipe to run.") (princ) Quote Link to comment Share on other sites More sharing options...
Zykl0 Posted October 23, 2008 Author Share Posted October 23, 2008 ok this work good i had little problem between metric and english unit but i need to set manually my measureinit variable for each drawing the routine still think i am in a metric plan inside an english plan. Quote Link to comment Share on other sites More sharing options...
CAB Posted October 23, 2008 Share Posted October 23, 2008 On the drawings that are not correct what do you get for each of these? (getvar "InsUnits") (getvar "MEASUREINIT") Quote Link to comment Share on other sites More sharing options...
Zykl0 Posted October 24, 2008 Author Share Posted October 24, 2008 I open template-English.dwt & template-metric.dwt Once in my metric template every label are working fine InsUnits= 4 Measureinit= 1 But in english Template is not working unless i manually switch measureinit InsUnits= 1 Measureinit= 1 (should be zero) Quote Link to comment Share on other sites More sharing options...
CAB Posted October 24, 2008 Share Posted October 24, 2008 See if this version fixes the problem: ;; CAB 10.23.08 version 1.4 ;; added skip of length too short for sizing ; CAB 10.24.08 version 1.5 ;; Changed test for Metric using MEASUREMENT ILO MEASUREINIT system var (defun c:LabelPipe (/ index ss obj lyr ept spt mpt mpt1 mpt2 txtht len len$ lst dUnits MinLen Metric txtoffset MainSize DistSize maketext kdub:roundNearest GetUnits) (defun maketext (pt ang str ht just lay sty / dxf72 dxf73) ;;(setq dxf72 (cdr (assoc just '(("TC" . 1 )("BC" . 1 ))))) (setq dxf73 (cdr (assoc just '(("TC" . 3) ("BC" . 1))))) (entmakex (list (cons 0 "TEXT") (cons 1 str) ; (the string itself) (cons 6 "BYLAYER") ; Linetype name (cons 7 sty) ;* Text style name, defaults to STANDARD, not current (cons 8 lay) ; layer (cons 10 pt) ;* First alignment point (in OCS) (cons 11 pt) ;* Second alignment point (in OCS) ;;(cons 39 0.0) ; Thickness (optional; default = 0) (cons 40 ht) ;* Text height ;;(cons 41 1.0) ; Relative X scale factor, Width Factor, defaults to 1.0 (cons 50 ang) ; Text rotation ange ;;(cons 51 0.0) ; Oblique angle (cons 71 0) ; Text generation flags (cons 72 1) ; Horizontal text justification type (cons 73 dxf73) ; Vertical text justification type ) ) ) ;;* kdub:roundNearest (numVal roundTo displayPrecision) ;; Round a numeric positive number to the NEAREST 'rounded' number ;; and format to n digits ;; kwb@theSwamp 20070814 (DEFUN kdub:roundNearest (numVal roundTo displayPrecision / remNum) (SETQ remNum (REM numVal roundTo)) (RTOS (IF (>= (* 2 remNum) roundTo) (+ numVal (- roundTo remNum)) (- numVal remNum) ) 2 displayPrecision ) ) ;; Returns the type of units (defun GetUnits (/ Units) (setq Units (getvar "InsUnits")) ; DesignCenter Drag Units (cond ((= Units 0) ;NoUnit (if (= (getvar "MEASUREMENT") 1) ; if metric "mm" ; use Millimeter "inch" ; else Inch ) ) (t (nth (1- Units) (list "inch" ;Inch "feet" ;Feet "mile" ;Mile "mm" ;Millimeter "cm" ;Centimeter "m" ;Meter "km" ;Kilometer "microinch" ;Micro inch "mil" ;Milli inch "yard" ;Yard "angstrom" ;Angstrom "nm" ;Nanometer "micron" ;Micron "dm" ;Decimeter "dam" ;Decameter "hm" ;Hectometer "gm" ;Gigameter "au" ;Astronomic unit "light_year" ;Light year "parsec" ;Parsec ) ) ) ) ) ;; use Royal Text Style if it exist (if (setq lst (tblsearch "style" "ROYAL")) (setq sty "ROYAL" txtht (cdr (assoc 40 lst)) ; calc the text height txtht (if (zerop txtht)(* (getvar "dimscale") 0.09375)txtht) ; correct for 0 ) ;; else use current text height (setq sty "STANDARD" ;;txtht (getvar 'textsize) ; calc the text height txtht (* (getvar "dimscale") 0.09375) ; calc the text height ) ) (setq dUnits (strcat " "(GetUnits))) (if (or (vl-position (getvar "InsUnits") '(4 5 6 7 12 14 15 16 17)) (= (getvar "MEASUREMENT") 1) ; if metric ) ;; Metric Units (setq txtoffset (/ txtht 2.0) ; text offset from line MainSize (strcat "50" dUnits) DistSize (strcat "10" dUnits) MinLen 305 ; Min Length to add text Metric t ) ;; English Units (setq txtoffset (/ txtht 2.0) ; text offset from line MainSize "2\"" DistSize "1\"" MinLen 12 ; Min Length to add text ) ) (setq index -1) (prompt "\nSelect pipes to label.") (if (setq ss (ssget '((0 . "LINE") (8 . "M-N-FP-DIS,M-N-FP-MAIN")))) (progn (command "._Undo" "_begin") (while (< (setq index (1+ index)) (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss index)) lyr (vla-get-layer obj) ept (vlax-get obj 'endpoint) spt (vlax-get obj 'startpoint) ang (angle spt ept) mpt (polar ept (angle ept spt) (/ (distance ept spt) 2.0)) len (vlax-get obj 'length) ) (if (> len MinLen) (progn (if (and (> ang (* 0.5 pi)) (<= ang (* 1.5 pi))) (setq ang (+ ang pi)) ) ;; text offset from pipe (setq mpt1 (polar mpt (+ ang (/ pi 2.0)) txtoffset) mpt2 (polar mpt (+ ang (* pi 1.5)) txtoffset) ) ;; adjust for Metric units rounded to 5 & 0 decimal points ;; or English Units rounded to 1/4 (if Metric ; if metric (setq len$ (strcat (kdub:roundNearest len 5 0) dUnits)) ; use Millimeter 05 (setq len$ (rtos len 4 2)) ; else Inch & 0.00 ) (cond ((= lyr "M-N-FP-MAIN") (maketext mpt1 ang MainSize txtht "BC" "M-N-FP-MAIN-DIA" sty) (maketext mpt2 ang len$ txtht "TC" "M-N-FP-MAIN-LIN" sty) ) ((= lyr "M-N-FP-DIS") (maketext mpt1 ang DistSize txtht "BC" "M-N-FP-DIS-DIA" sty) (maketext mpt2 ang len$ txtht "TC" "M-N-FP-DIS-LIN" sty) ) ) )) ) (command "._Undo" "_end") ) ) (princ) ) (prompt "\nLabel pipe lisp loaded, Enter LabelPipe to run.") (princ) Quote Link to comment Share on other sites More sharing options...
Zykl0 Posted October 24, 2008 Author Share Posted October 24, 2008 it work it work! Quote Link to comment Share on other sites More sharing options...
CAB Posted October 24, 2008 Share Posted October 24, 2008 Very good, I made a minor revision to the code above if you want to get the last version. 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.