Lisp for auto-dimensioning tons of lines.

[CAB]

This is the last revision, never posted it.

;;  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
;;  Zykl0 10.24.08  version 1.5.1
;;  Changed Some Layers and textstyle to fit new template
;;  CAB 11.08.08  version 1.6
;;  Correction for line angle test and revised maketext call
(defun c:LabelPipe (/ index ss obj lyr ept spt mpt mpt1 mpt2 txtht len len$ lst dUnits
                   MinLen Metric
                   txtoffset 25Size 32Size 40Size 50Size 65Size 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" "Royaltech"))
   (setq sty "Royaltech"
         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
         25Size  (strcat "25")
         32Size  (strcat "32")
         40Size  (strcat "40")
         50Size  (strcat "50")
         65Size  (strcat "65")
         MinLen    305  ; Min Length to add text
         Metric    t
   )
   ;;  English Units
   (setq txtoffset (/ txtht 2.0) ; text offset from line
         25Size  "1\""
         32Size  "1¼\""
         40Size  "1½\""
         50Size  "2\""
         65Size  "2½\""
         MinLen    12  ; Min Length to add text
   )
 )
 
 (setq index -1)
 (prompt "\nSelect pipes to label.")
 (if (setq ss
            (ssget '((0 . "LINE")
                     (8 . "M-N-INC-CPVC-25,M-N-INC-CPVC-32,M-N-INC-CPVC-40,M-N-INC-CPVC-50,M-N-INC-CPVC-65"))))
   (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) 0.0001)) (<= ang (+ (* 1.5 pi) 0.0001)))
         (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))) ; use Millimeter 05 
         (setq len$ (rtos len 4 2)) ; else Inch & 0.00
       )

       (maketext mpt1 ang (eval(read(strcat (substr lyr (1- (strlen lyr))) "Size")))
                 txtht "BC" (strcat lyr "-DIA") sty)
       (maketext mpt2 ang len$ txtht "TC" (strcat lyr "-LIN") sty)

      ))
     )
     (command "._Undo" "_end")
   )
 )
 (princ)
)
(prompt "\nLabel pipe lisp loaded, Enter LabelPipe to run.")
(princ)

[MTTLP]

Thank you please tell me I can not use

[SLW210]

Read THIS ..................