Lisp That Dimensions a Rectangle

[dreno99]

Hey,

Someone else wrote the following. It does exactly what I want it to do, except for one thing. The units are decimal, while I want fractional.

The units in both the drawing and dimsstyle are fractional. I cannpt pick out the code that grabs or calculates the label values.

please reply if you can help. hit me at davidr at fmgraham . com if you want. I have hundreds and hundreds of glass panes to size, and this should cut my work in about half if i can get it to work properly.

thanks. Oh yeah, vanilla AUtoCAD 2013. Windows 7 on a Dell

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

[_Tharwat]

Replace the following and let me know

(setq Str (strcat (rtos Len 5 2) "x" (rtos Wid 5 2)))

[dreno99]

Thank you! 

it works - kind of. I need the precision to be 1/32 on both width & height. precision appears to be good to an 1/8th now.

[_Tharwat]

Increase the number 2 to the number of precisions you want

[dreno99]

Yep, figured that out, but thank you agfain.

it is trial and error? I think I am up to 5 and this may get me 1/32" precision. yay! i have hundreds or thousands of these to get sizes of - this is huge.

[_Tharwat]

You're welcome

[Anonymous]

Hi Tim!

I just tried your routine and it works great! Just out of curiosity, I use it to identify glass dimensions in curtain walls and I don't need as much precision as 2 decimals. I tried to tweak it a little but unfortunately as I am not as king pin as you I can't figure out what is the value I need to change in your code...

Thanks in advance for your help!

Cheers and have a nice day!

William

[Kent1Cooper]

---

@info wrote:

... I don't need as much precision as 2 decimals. .... I can't figure out what is the value I need to change in your code...

---

It's in the (rtos) functions [real-number to string conversion].  Change this line:

  (setq Str (strcat (rtos Len 2 2) "x" (rtos Wid 2 2)))

The red numbers are the mode [2 = decimal], and the green numbers are the precision [here, 2 decimal places].  Read about (rtos) in Help to find what the choices are, and change those numbers to whatever you prefer.