Lisp for auto-dimensioning ton

CAB · 发表于 2022-7-6 08:33:54

This does not work
Text ht 7" times dimscale 96 = 672 text height

Text ht 7" times [96/2] = 336 text gap

CAB · 发表于 2022-7-6 08:36:50

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

[code]; 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)) (

Zykl0 · 发表于 2022-7-6 08:39:50

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

copy

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

CAB · 发表于 2022-7-6 08:44:06

Glad it worked.
Try this revision, I didn't test.
See new variable MinLen

[code];; 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)) (

Zykl0 · 发表于 2022-7-6 08:46:09

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.

CAB · 发表于 2022-7-6 08:49:46

On the drawings that are not correct what do you get for each of these?

copy

(getvar "InsUnits")(getvar "MEASUREINIT")

Zykl0 · 发表于 2022-7-6 08:53:23

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)

CAB · 发表于 2022-7-6 08:55:37

See if this version fixes the problem:

[code];; 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)) (

Zykl0 · 发表于 2022-7-6 08:58:33

it work it work!

CAB · 发表于 2022-7-6 09:04:02

Very good, I made a minor revision to the code above if you want to get the last version.

[编程交流] Lisp for auto-dimensioning ton

发表回复

精选推荐