Juergen Posted January 29, 2018 Share Posted January 29, 2018 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 29, 2018 Share Posted January 29, 2018 (edited) 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, 2020 by Lee Mac Quote Link to comment Share on other sites More sharing options...
Juergen Posted January 30, 2018 Author Share Posted January 30, 2018 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 30, 2018 Share Posted January 30, 2018 No problem - I've updated the above code. Quote Link to comment Share on other sites More sharing options...
Juergen Posted January 30, 2018 Author Share Posted January 30, 2018 Hi, Lee Thank you very much. You help me a lot. ( I also use programms from your website:)) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 30, 2018 Share Posted January 30, 2018 Excellent - you're welcome! Quote Link to comment Share on other sites More sharing options...
Hector Posted July 27, 2020 Share Posted July 27, 2020 (edited) 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, 2020 by Hector Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 27, 2020 Share Posted July 27, 2020 Thank you for your kind words - I've updated my earlier post to remove the BBCode formatting tags. Quote Link to comment Share on other sites More sharing options...
Hector Posted July 28, 2020 Share Posted July 28, 2020 Bless you m8!! Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.