Jump to content

Lisp - to switch pt1 to pt2 - help

Zykl0

By Zykl0
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Zykl0 Contributor

Zykl0

Posted
Posted

Hi!

 

I'm looking for a lisp able to switch pt1 to pt2 from a line

with one condition ... only if pt2 > pt1 in the Y axis.

 

pt1 = Good

l

l

l

l

pt2 = Good

 

pt2 = Bad

l

l

l

l

pt1 = Bad

 

Any idea?

thank you.

  • 3 weeks later...
Zykl0 Contributor

Zykl0

Posted
  • Author
Posted

i really would like to know if its possible please :)

ASMI Proficient

ASMI

Posted
Posted

You had it in view of?

 

(defun c:test(/ pt1 pt2)
 (and
   (setq pt1(getpoint "\nSpecify pt1: "))
   (setq pt2(getpoint "\nSpecify pt2: "))
   (>(cadr pt2)(cadr pt1))
   (vl-cmdf "_.line" pt1 pt2 "")
   ); end and
 (princ)
 ); end of c:test

wizman Rising Star

wizman

Posted
Posted

here's for lines:

 

(defun c:linewiz ()
   (vl-load-com)
   (defun MkLine (p1 p2 lw_lay)
(entmakex (list	(cons 0 "LINE")
		(cons 8 lw_lay)
		(cons 10 p1)
		(cons 11 p2)
	  ) ;_ end_list
) ;_ end_entmakex
   ) ;_ end_defun
   (if	(setq lw_set (ssget '((0 . "LINE"))))
(progn
    (setq counter 0)
    (while (< counter (sslength lw_set))
	(setq lw_ent (ssname lw_set counter))
	(setq lw_lay (cdr (assoc 8 (entget lw_ent))))
	(if
	    (< (cadr (setq lw_stpt
			      (vlax-curve-getStartPoint
				  lw_ent
			      ) ;_ end_vlax-curve-getStartPoint
		     ) ;_ end_setq
	       ) ;_ end_cadr
	       (cadr (setq lw_endpt
			      (vlax-curve-getendpoint
				  lw_ent
			      ) ;_ end_vlax-curve-getendpoint
		     ) ;_ end_setq
	       ) ;_ end_cadr
	    ) ;_ end_<
	       (progn
		   (mkline lw_endpt lw_stpt lw_lay)
		   (entdel lw_ent)
	       ) ;_ end_progn
	) ;_ end_if
	(setq counter (1+ counter))
    ) ;_ end_while
) ;_ end_progn
   ) ;_ end_if
   (princ)
) ;_ end_defun

Zykl0 Contributor

Zykl0

Posted
  • Author
Posted

Working good but this is not solving the problem i have.

 

Ill explain why...

 

heres is a code that CAB did for me

 

;;  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
(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)) (<= 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))) ; use Millimeter 05 
         (setq len$ (rtos len 4 2)) ; else Inch & 0.00
       )
       (cond
         ((= lyr "M-N-INC-CPVC-25")
          (maketext mpt1 ang 25Size txtht "BC" "M-N-INC-CPVC-25-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-25-LIN" sty)
         )
         ((= lyr "M-N-INC-CPVC-32")
          (maketext mpt1 ang 32Size txtht "BC" "M-N-INC-CPVC-32-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-32-LIN" sty)
         )
         ((= lyr "M-N-INC-CPVC-40")
          (maketext mpt1 ang 40Size txtht "BC" "M-N-INC-CPVC-40-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-40-LIN" sty)
         )
         ((= lyr "M-N-INC-CPVC-50")
          (maketext mpt1 ang 50Size txtht "BC" "M-N-INC-CPVC-50-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-50-LIN" sty)
         )
         ((= lyr "M-N-INC-CPVC-65")
          (maketext mpt1 ang 65Size txtht "BC" "M-N-INC-CPVC-65-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-65-LIN" sty)
         )
       )
      ))
     )
     (command "._Undo" "_end")
   )
 )
 (princ)
)
(prompt "\nLabel pipe lisp loaded, Enter LabelPipe to run.")
(princ)

this is for labeling different size of pipe.

with diameter above the pipe and lenght under...

but sometime (very rarely) the diameter is under and lenght above (dont know why)

 

i'm attaching a dwg with 2 line who are very similar and labeling is inverted. i really would like to know why...

INVERT.dwg

wizman Rising Star

wizman

Posted
Posted

****edit****

 

i deleted my post since it does not resolve the issue on the attached drawing. switching pt1 with pt2 is not the way. there might be a very small delta x for the lines. original routine works fine for ypt1>ypt2 or ypt2>ypt1.

wizman Rising Star

wizman

Posted
Posted

TRY THIS:

 

;;  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
(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)) (< ang (* 1.5 pi)))
         (setq ang (+ ang pi))
       )
(if (or (equal ang (* 0.5 pi)0.0001) (equal ang (* 1.5 pi)0.0001))
(setq ang (* 0.5 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
       )
       (cond
         ((= lyr "M-N-INC-CPVC-25")
          (maketext mpt1 ang 25Size txtht "BC" "M-N-INC-CPVC-25-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-25-LIN" sty)
         )
         ((= lyr "M-N-INC-CPVC-32")
          (maketext mpt1 ang 32Size txtht "BC" "M-N-INC-CPVC-32-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-32-LIN" sty)
         )
         ((= lyr "M-N-INC-CPVC-40")
          (maketext mpt1 ang 40Size txtht "BC" "M-N-INC-CPVC-40-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-40-LIN" sty)
         )
         ((= lyr "M-N-INC-CPVC-50")
          (maketext mpt1 ang 50Size txtht "BC" "M-N-INC-CPVC-50-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-50-LIN" sty)
         )
         ((= lyr "M-N-INC-CPVC-65")
          (maketext mpt1 ang 65Size txtht "BC" "M-N-INC-CPVC-65-DIA" sty)
          (maketext mpt2 ang len$ txtht "TC" "M-N-INC-CPVC-65-LIN" sty)
         )
       )
      ))
     )
     (command "._Undo" "_end")
   )
 )
 (princ)
)
(prompt "\nLabel pipe lisp loaded, Enter LabelPipe to run.")
(princ)

CAB Proficient

CAB

Posted
Posted

Another solution is to use this:

        (if (and (> ang (- (* 0.5 pi) 0.0001)) (<= ang (+ (* 1.5 pi) 0.0001)))
         (setq ang (+ ang pi))
       )

CAB Proficient

CAB

Posted
Posted

Added the code plus I revised the way you call maketext.

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

wizman Rising Star

wizman

Posted
Posted
(if (and (> ang (- (* 0.5 pi) 0.0001)) (

(setq ang (+ ang pi))

)

 

good solution as always alan, thanks for sharing.

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.

×
 Share
Go to topic listing
×
×
  • Create New...