Author Topic: area in text  (Read 1650 times)

0 Members and 1 Guest are viewing this topic.

ampm6170

  • Guest
area in text
« on: June 15, 2005, 11:38:50 AM »
i need to find out the area of many rooms and show the area on the drawing. instead of plugging those numbers (areas) everytime by using TEXT , is there any other quicker way to do the numbering after checking the area?

thanks

ronjonp

  • Needs a day job
  • Posts: 7529
area in text
« Reply #1 on: June 15, 2005, 11:50:54 AM »
Try this:

Code: [Select]
;Puts text with objects area in it unless it is 0.00*------Many thanks to the SWAMP.ORG for all the help

(defun c:rat (/ *error* u-clayer getboundingbox llc urc s1 index ent obj bbox mpt obj_area txt deltext a n)
(setq a 0)
(command ".undo" "begin")
   (command ".style" "arial" "arial" "" "" "" "" "" "")
   (prompt "\nARIAL is now the current text style")
(princ)
(vl-load-com)

;_____________________________
;Error function
;_____________________________

(defun *error* (msg)
   (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    ) ; if
(setvar 'clayer u-clayer)
    (princ)
  ) ;end error function

;_____________________________
;Get User Variables
;_____________________________

(setq u-clayer (getvar 'clayer))
(if (tblsearch "layer" "area")
  (command "-layer" "thaw" "area" "on" "area" "")
  (princ "\n Layer 'area' Created")
)
(command ".-layer" "m" "area" "")
 
  (defun getboundingbox (obj / minpt maxpt)
    (vla-getboundingbox obj 'minpt 'maxpt)
    (mapcar 'vlax-safearray->list (list minpt maxpt))
    (setq llc (vlax-safearray->list minpt)
          urc (vlax-safearray->list maxpt)
    )
    (list llc urc)
  )
  (if (setq sl (ssget '((0 . "LWPOLYLINE,CIRCLE,REGION,POLYLINE,ELLIPSE,SPLINE"))

               )
      )

    (progn
      (setq index -1)
      (while (< (setq index (1+ index)) (sslength sl))
        (setq ent (ssname sl index))
        (setq obj (vlax-ename->vla-object ent))
        (setq bbox (getboundingbox obj)
              llc (car bbox)
              urc (cadr bbox)
              mpt (list (/ (+ (car llc) (car urc)) 2) (/ (+ (cadr llc) (cadr urc)) 2))
        )

        (setq obj_area (vlax-get-property obj 'area))
        (setq txt (strcat (rtos obj_area)))
        (command "text" "j" "mc" mpt (* (getvar "dimscale") 0.15) "0" txt)

        (princ)
      )
    )
  )
(setq deltext (setq s1 (ssget "x"'((0 . "Text")(8 . "area")(1 . "0.00*")))))
(command ".erase" deltext "")
(princ)
(*error* "")
(setvar 'clayer u-clayer)
(princ (strcat (itoa index) " entities processed..."))
(progn
      (setq n (1- (sslength sl)))
      (while (>= n 0)
(command "_.area" "_o" (ssname sl n))
(setq a (+ a (getvar "area"))
     n (1- n)
)
      )
      (prompt (strcat "\n The TOTAL AREA of " (itoa index) " processed items = "
        "\n" (rtos (/ a 1) 2 3)" sq. ft."
  "\n" (rtos (/ a 43560) 2 3)" acres"
        "\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
        "\n" (rtos (/ a 144) 2 3)" - this number converted sq. inches to sq. feet (architectural units)"
        "\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
  "\n" "Be aware that unclosed polylines and splines"
  "\n" "have an area too and will be accounted for if selected..."

            )

  )

      (alert (strcat "\n The TOTAL AREA of " (itoa index) " processed items = "
        "\n" (rtos (/ a 1) 2 3)" sq. ft."
  "\n" (rtos (/ a 43560) 2 3)" acres"
        "\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
        "\n" (rtos (/ a 144) 2 3)" - this number converted sq. inches to sq. feet (architectural units)"
        "\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
  "\n" "Be aware that unclosed polylines and splines"
  "\n" "have an area too and will be accounted for if selected..."

            )

  )
)
(princ)
(command ".undo" "end")
(princ)
)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Crank

  • Water Moccasin
  • Posts: 1503
area in text
« Reply #2 on: June 15, 2005, 03:01:02 PM »
I say: FIELDS :P

Don't have a clue how to do that in lisp, but fields are so for this.
Vault Professional 2023     +     AEC Collection