Lisp for auto-dimensioning tons of lines.

[Zykl0]

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

[CAB]

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)

[Zykl0]

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!)

[CAB]

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.

[CAB]

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?

[Zykl0]

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.

[CAB]

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)

[Zykl0]

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

[CAB]

I updated the code above, give it a try.

Modified it again anticipating the need for pipe size change in metric version.

[Zykl0]

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