Jump to content

Lisp for auto-dimensioning tons of lines.


Zykl0

Recommended Posts

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 o:).

 

-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 :cry:

Link to comment
Share on other sites

  • Replies 22
  • Created
  • Last Reply

Top Posters In This Topic

  • CAB

    12

  • Zykl0

    9

  • SLW210

    1

  • MTTLP

    1

Top Posters In This Topic

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)

Link to comment
Share on other sites

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 :oops:

 

Thank you again you made my day! (maybe month!)

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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 :roll:

Link to comment
Share on other sites

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 :unsure:

 

 

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...