Zum Hauptinhalt springen

Total Area Autocad Lisp -

If you want control over every detail, writing your own 10-line LISP is straightforward.

To calculate the total area of multiple objects in AutoCAD using Lisp (AutoLISP), you can use a simple script that sums up the areas of the selected objects. This script will work with entities like polygons, polylines (2D), circles, and arcs, provided they are closed and have an area.

Here is a basic Lisp routine to do this:

(defun c:totalarea (/ ss i ent area totalarea)
  (setq ss (ssget "X" '((0 . "POLYGON, POLYLINE, CIRCLE, ARC"))))
  (if ss
    (progn
      (setq totalarea 0)
      (setq i 0)
      (repeat (setq i (sslength ss))
        (setq ent (ssname ss i))
        (cond
          ((= (cdr (assoc 0 (entget ent))) "POLYLINE")
           (setq area (vlax-curve-get-area ent)))
          ((= (cdr (assoc 0 (entget ent))) "POLYGON")
           (setq area (cdr (assoc 41 (entget ent)))))
          ((= (cdr (assoc 0 (entget ent))) "CIRCLE")
           (setq area (* pi (expt (cdr (assoc 40 (entget ent))) 2))))
          ((= (cdr (assoc 0 (entget ent))) "ARC")
           (setq area (* pi (expt (cdr (assoc 40 (entget ent))) 2) (/ (cdr (assoc 42 (entget ent))) 360)))
          )
        (setq totalarea (+ totalarea area))
        (setq i (1+ i))
      )
      (princ (strcat "\nTotal Area: " (rtos totalarea 2 2) " square units"))
    )
    (princ "\nNo objects selected.")
  )
  (princ)
)

To use this Lisp routine:

The script prompts you to select objects by automatically selecting all polygons, polylines, circles, and arcs in the drawing. It then calculates and displays the total area of these objects. total area autocad lisp

Keep in mind that:

This script assumes a simple use case. Depending on your specific needs, you might need to adjust it. For example, you might want to filter the selection based on layer or color, or handle more complex entities.

;;; TOTALAREA.LSP
;;; Calculates total area of selected objects
;;; Supports: Circles, Ellipses, Hatches, Polylines (2D/3D),
;;;           Regions, Splines (planar)
(defun C:TOTALAREA (/ ss total-area obj-list obj area obj-name
                    cnt *error* old-cmdcho old-dimzin)
;; Error handler
  (defun *error* (msg)
    (if old-cmdcho (setvar "CMDECHO" old-cmdcho))
    (if old-dimzin (setvar "DIMZIN" old-dimzin))
    (if (not (member msg '("Function cancelled" "quit / exit abort")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
;; Save system variables
  (setq old-cmdcho (getvar "CMDECHO"))
  (setq old-dimzin (getvar "DIMZIN"))
  (setvar "CMDECHO" 0)
  (setvar "DIMZIN" 0)  ; Suppress trailing zeros
(princ "\nSelect objects to calculate total area...")
  (setq ss (ssget '((-4 . "<OR")
                     (0 . "CIRCLE")
                     (0 . "ELLIPSE")
                     (0 . "HATCH")
                     (0 . "LWPOLYLINE")
                     (0 . "POLYLINE")
                     (0 . "REGION")
                     (0 . "SPLINE")
                     (0 . "ARC")      ; Arc (converted to region)
                     (0 . "LINE")     ; Line (converted to region)
                     (0 . "LWPOLYLINE")
                     (-4 . "OR>"))))
(if (not ss)
    (princ "\nNo objects selected.")
    (progn
      (setq total-area 0.0)
      (setq obj-list '())
      (setq cnt 0)
;; Process each selected object
      (repeat (setq cnt (sslength ss))
        (setq obj (ssname ss (setq cnt (1- cnt))))
        (setq obj-name (cdr (assoc 0 (entget obj))))
;; Calculate area based on object type
        (cond
          ;; For objects with direct Area property
          ((member obj-name '("CIRCLE" "ELLIPSE" "HATCH" "LWPOLYLINE" 
                              "POLYLINE" "REGION" "SPLINE"))
           (command "._AREA" "_O" obj)
           (setq area (getvar "AREA"))
           (if (> area 0)
             (progn
               (setq total-area (+ total-area area))
               (setq obj-list (cons (list obj-name area) obj-list))
             )
           )
          )
;; For objects that need conversion (lines, arcs)
          ((member obj-name '("LINE" "ARC"))
           (princ (strcat "\nConverting " obj-name " to region for area calculation..."))
           (command "._REGION" obj "")
           (if (setq region-ent (entlast))
             (progn
               (command "._AREA" "_O" region-ent)
               (setq area (getvar "AREA"))
               (if (> area 0)
                 (progn
                   (setq total-area (+ total-area area))
                   (setq obj-list (cons (list obj-name area) obj-list))
                 )
               )
               (command "._ERASE" region-ent "") ; Clean up temporary region
             )
             (princ (strcat "\nFailed to convert " obj-name " to region"))
           )
          )
(t
           (princ (strcat "\nUnsupported object type: " obj-name))
          )
        )
      )
;; Display results
      (princ "\n========================================")
      (princ "\nAREA CALCULATION RESULTS")
      (princ "\n========================================")
(if obj-list
        (progn
          (foreach item (reverse obj-list)
            (princ (strcat "\n" (car item) ": " 
                          (rtos (cadr item) 2 2) " sq units"))
          )
(princ "\n----------------------------------------")
          (princ (strcat "\nTOTAL AREA: " (rtos total-area 2 2) " sq units"))
;; Offer to display in different units
          (initget "Yes No")
          (if (= (getkword "\nDisplay in different units? [Yes/No] <No>: ") "Yes")
            (progn
              (princ "\nSelect unit conversion:")
              (princ "\n  1 - Square feet")
              (princ "\n  2 - Square meters")
              (princ "\n  3 - Square yards")
              (initget 1 "1 2 3")
              (setq unit (getkword "\nEnter choice [1/2/3]: "))
              (cond
                ((= unit "1") ; sq ft
                 (setq converted (* total-area 144.0)) ; assuming drawing units in inches
                 (princ (strcat "\nConverted: " (rtos converted 2 2) " sq ft")))
                ((= unit "2") ; sq meters
                 (setq converted (* total-area 0.00064516)) ; sq inches to sq meters
                 (princ (strcat "\nConverted: " (rtos converted 2 2) " sq meters")))
                ((= unit "3") ; sq yards
                 (setq converted (* total-area 0.000771605)) ; sq inches to sq yards
                 (princ (strcat "\nConverted: " (rtos converted 2 2) " sq yards")))
              )
            )
          )
;; Option to write total to command line
          (princ "\n========================================")
;; Copy total area to clipboard (optional)
          (initget "Yes No")
          (if (= (getkword "\nCopy total area to clipboard? [Yes/No] <No>: ") "Yes")
            (progn
              (setq area-str (rtos total-area 2 2))
              (command "._SETENV" "Clipboard" area-str)
              (princ "\nTotal area copied to clipboard!")
            )
          )
        )
        (princ "\nNo valid area objects selected.")
      )
    )
  )
;; Restore system variables
  (setvar "CMDECHO" old-cmdcho)
  (setvar "DIMZIN" old-dimzin)
  (princ)
)
;;; Command alias
(defun C:TA () (C:TOTALAREA))
;;; Load message
(princ "\nTOTALAREA.LSP loaded successfully!")
(princ "\nType 'TOTALAREA' or 'TA' to calculate total area.")
(princ)

AutoCAD’s AREA command works fine for one or two objects. But for multiple areas?

After the tenth time doing this dance, I wrote a 15-line LISP that does it automatically. If you want control over every detail, writing

This Visual LISP function works on any curve and returns a real number.

Copy the following text exactly into a blank Notepad file. Save it with the name TOTAREA.LSP (ensure the extension is .lsp, not .txt).

;;; TOTAREA.LSP - Calculate total area of selected objects
;;; Command: TOTAREA
;;; Supports: LWPOLYLINE, CIRCLE, ELLIPSE, SPLINE, REGION, HATCH

(defun C:TOTAREA ( / ss total area obj_name obj_list i ent) (princ "\nSelect objects to calculate total area: ")

;; Step 1: Create a selection set (setq ss (ssget '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE,SPLINE,REGION,HATCH")))) To use this Lisp routine:

;; Step 2: Exit if nothing is selected (if (null ss) (princ "\nNo valid objects selected.") (progn (setq total 0.0) ; Initialize total to zero (setq i 0) ; Initialize counter

  ;; Step 3: Loop through each object in the selection set
  (repeat (sslength ss)
    (setq ent (ssname ss i))        ; Get entity name
    (setq obj_name (cdr (assoc 0 (entget ent)))) ; Get object type
;; Step 4: Calculate area based on object type
    (cond
      ;; For Polylines, Circles, Ellipses, Splines
      ((member obj_name '("LWPOLYLINE" "CIRCLE" "ELLIPSE" "SPLINE"))
       (command "_.AREA" "_Object" ent)
       (setq area (getvar "AREA"))
      )
      ;; For Regions
      ((equal obj_name "REGION")
       (setq area (vla-get-area (vlax-ename->vla-object ent)))
      )
      ;; For Hatches
      ((equal obj_name "HATCH")
       (setq area (vla-get-area (vlax-ename->vla-object ent)))
      )
    )
;; Step 5: Add area to total
    (if area
      (setq total (+ total area))
      (princ (strcat "\nWarning: Could not compute area for object " (itoa i)))
    )
    (setq i (1+ i))    ; Increment counter
    (setq area nil)    ; Reset area variable
  ) ; end repeat
;; Step 6: Display the result
  (princ "\n=========================================")
  (princ (strcat "\n>>> TOTAL AREA: " (rtos total 2 2) " square units <<<"))
  (princ "\n=========================================")
) ; end progn

) ; end if (princ) ; Clean exit )


(defun C:MYAREA ( / ss total obj area cnt)