Label Rectangle

[Juergen 11]

Hi,

I´m working with the Code "Labelrec".

It works perfect, but is it possible to write always the lenght from the rectangle as first in the text line? e.g. when the length is smaller then the width.

 

(defun c:LabelRec (/ ActDoc CurSpace Ht ss cnt Ent EntData VerPoints tmpEnt Wid Len Pt Str tmpText tmpDist1 tmpDist2)
; Label rectangles with length and width in middle of them.

(vl-load-com)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= (getvar "cvport") 1)
(setq CurSpace (vla-get-PaperSpace ActDoc))
(setq CurSpace (vla-get-ModelSpace ActDoc))
)
(if (and (setq Ht (getreal "\n Enter height of text: ")) (setq ss (ssget '((0 . "*POLYLINE")))))
(progn
 (setq cnt 0)
 (while (setq Ent (ssname ss cnt))
  (setq EntData (entget Ent))
  (if (= (cdr (assoc 0 EntData)) "LWPOLYLINE")
   (setq VerPoints (vlax-get (vlax-ename->vla-object Ent) 'Coordinates))
   (progn
    (setq VerPoints nil)
    (setq tmpEnt (entnext Ent))
    (while (not (equal (cdr (assoc 0 (entget tmpEnt))) "SEQEND"))
     (setq tmpPt (cdr (assoc 10 (entget tmpEnt))))
     (setq VerPoints (append VerPoints (list (car tmpPt))))
     (setq VerPoints (append VerPoints (list (cadr tmpPt))))
     (setq tmpEnt (entnext tmpEnt))
    )
   )
  )
  (if (= (length VerPoints) 
   (progn
    (setq tmpDist1 (distance (list (nth 0 VerPOints) (nth 1 VerPoints)) (list (nth 2 VerPoints) (nth 3 VerPoints))))
    (setq tmpDist2 (distance (list (nth 2 VerPOints) (nth 3 VerPoints)) (list (nth 4 VerPoints) (nth 5 VerPoints))))
    (if (< tmpDist1 tmpDist2)
     (setq Len tmpDist2 Wid tmpDist1)
     (setq Len tmpDist1 Wid tmpDist2)
    )
    (setq Pt (list (/ (+ (nth 0 VerPoints) (nth 4 VerPoints)) 2.0) (/ (+ (nth 1 VerPoints) (nth 5 VerPoints)) 2.0) 0.0))
    (setq Str (strcat (rtos Len 2 2) "x" (rtos Wid 2 2)))
    (setq tmpText (vla-AddText CurSpace Str (vlax-3d-point Pt) Ht))
    (vla-put-Alignment tmpText 4)
    (vla-put-TextAlignmentPoint tmpText (vlax-3d-point Pt))
   )
  )
  (setq cnt (1+ cnt))
 )
)
)
(princ)
)                                                                                                                                                                               
            

Thank for your help

[Lee Mac 372]

Try the following code:

(defun c:labelrec ( / ent enx hgt idx len lst sel vte vtx wid zco )
   (initget 6)
   (setq hgt (cond ((getdist (strcat "\nSpecify text height <" (rtos (getvar 'textsize)) ">: "))) ((getvar 'textsize))))

   (if
       (setq sel
           (ssget
              '(
                   (0 . "*POLYLINE")
                   (-4 . "&=") (70 . 1)
                   (-4 . "<OR")
                       (-4 . "<AND")
                           (0 . "LWPOLYLINE")
                           (90 . 4)
                           (-4 . "<NOT")
                               (-4 . "<>") (42 . 0.0)
                           (-4 . "NOT>")
                       (-4 . "AND>")
                       (-4 . "<AND")
                           (0 . "POLYLINE")
                           (-4 . "<NOT")
                               (-4 . "&") (70 . 94)
                           (-4 . "NOT>")
                       (-4 . "AND>")
                   (-4 . "OR>")
               )
           )
       )
       (repeat (setq idx (sslength sel))
           (setq idx (1- idx)
                 ent (ssname sel idx)
                 enx (entget ent)
                 lst nil
           )
           (if (= "LWPOLYLINE" (cdr (assoc 0 enx)))
               (setq zco (cdr (assoc 38 enx))
                     lst (mapcar '(lambda ( x ) (list (cadr x) (caddr x) zco)) (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx))
               )
               (progn
                   (setq vte (entnext ent)
                         vtx (entget  vte)
                   )
                   (while  (= "VERTEX" (cdr (assoc  0 vtx)))
                       (setq lst (cons (cdr (assoc 10 vtx)) lst)
                             vte (entnext vte)
                             vtx (entget  vte)
                       )
                   )
               )
           )
           (if (= 4 (length lst))
               (progn
                   (setq len (distance (car  lst) (cadr  lst))
                         wid (distance (cadr lst) (caddr lst))
                   )
                   (if (< len wid) (setq lst (cdr lst)))
                   (entmake
                       (list
                          '(000 . "TEXT")
                          '(072 . 4)
                          '(073 . 0)
                           (cons  040 hgt)
                           (cons  001 (strcat (rtos len 2 2) "x" (rtos wid 2 2)))
                           (cons  010 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car lst) (caddr lst)))
                           (cons  011 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car lst) (caddr lst)))
                           (cons  050 (LM:readable (angle (car lst) (cadr lst))))
                           (assoc 210 enx)
                       )
                   )
               )
           )
       )
   )
   (princ)
)

;; Readable  -  Lee Mac
;; Returns an angle corrected for text readability.

(defun LM:readable ( a )
   (   (lambda ( a )
           (if (< a 0.0)
               (LM:readable a)
               (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
                   (LM:readable (+ a pi))
                   a
               )
           )
       )
       (rem (+ a pi pi) (+ pi pi))
   )
)

(princ)

 

Edited July 27 by Lee Mac

[Juergen 11]

Hi Lee,

 

Thank you for the answer.

Can you change the lisp file that

the text from the rectangle look like the example image file.

 

Thank you for your help.

Example.dwg

[Lee Mac 372]

No problem - I've updated the above code.

[Juergen 11]

Hi, Lee

 

Thank you very much.

You help me a lot.

 

( I also use programms from your website:))

[Lee Mac 372]

Excellent - you're welcome!

[Hector 0]

Hi, i have been trying to use LabelRec with AutoCAD 2019, and i have many issues. I will list them.

• If i try to use the Code above (original script) i get UNKNOWN COMMAND even though i load the lsp
• If i mess around with the (parentheses) i get it to run, but it goes into an infinite loop on only the first rectangle selected
• If i cancel out on the routine, i still get the label for that rectangle. Actually i get around 80.000 duplicates for every second it runs.

Can you help me out on this? Im not really a programmer and im having a real hard time ( been trial and error'n  all morning) I will attach two lisp files.

LabelRecOriginal is the code exactly as seen pasted onto notepad++ and saved as .lsp

l1 is my modified version that runs on an infinite loop.Run it but once it starts working cancel(ESC) immediately. If you don't its gonna crash eventually. 

My guess is that something is way of with the () on the original but no matter what i try it doesn't work properly..

 

Thanks for any input btw! 

PS LeeMac You have been my hero for years on no end. Thanx for everything!

LabelRecOriginal.lsp l1.lsp

Edited July 27 by Hector

[Lee Mac 372]

Thank you for your kind words - I've updated my earlier post to remove the BBCode formatting tags.

[Hector 0]

Bless you m8!!