AREA command in autolisp not working in block and sometimes in modelspace.

[varg.zaugg]

Calling

(command "AREA" "O" (car (entsel)))

Sometimes works in modelspace and sometimes doesn't. 

Calling this command inside a Block, doesnt work at all and throws: <Bad Entity name: 2A9B500>

and causes kind of infinite loop. However, the command works without problems without blocks (only filtering surfaces). My code for extracting surface areas from blocks and there only this kinds of surface objects inside:

(defun get_block_surface_areas ( / i:BlockObjectName i:BlockObject
                                   i:BlockName i:InsertVLA  Total)

  (setq InsertSelectionSet    (ssget '((0 . "INSERT")))
        Counter         -1
        Total            0
  );setq

  (while (setq i:InsertObject   (ssname InsertSelectionSet (setq Counter (1+ Counter))))

         (setq
            i:InsertVLA       (vlax-ename->vla-object i:InsertObject)
            i:BlockName       (vla-get-effectivename  i:InsertVLA)
            i:BlockObject     (tblobjname "Block"     i:BlockName)
         );setq

         (while (setq i:BlockObject (entnext i:BlockObject))

                (setq i:BlockObjectName (cdr (assoc 0 (entget i:BlockObject))));setq

                (if (or (= i:BlockObjectName  "PLANESURFACE")
                        (= i:BlockObjectName  "NURBSURFACE")
                        (= i:BlockObjectName  "EXTRUDEDSURFACE")
                        (= i:BlockObjectName  "SURFACE")
                        (= i:BlockObjectName  "REGION")
                    );or

                    (progn 
                        (command "AREA" "O" i:BlockObject)
                        (while (< 0 (getvar 'cmdactive)) (command ""))
                        (setq Total (+ Total (getvar 'area)))
                    );progn
                );if
         );while
  );while
);get_block_surface_areas 

Where is the problem?

[Moshe-A]

@varg.zaugg  hi,

You want to select a block reference (an insert) and get it's area?

an insert is a compound unit contains from one to infinite objects

for a sec try to think as AutoCAD which area do you want it to return if the block contains

some lines, some open plines, some arcs and texts?!

what object(s) your block contains that you want to get area?

Moshe

[varg.zaugg]

I want to extract areas of surfaces in inserts, right. Hence I call the "BLOCK" object with:

(tblobjname "Block" "NameOfInsertObject")

and 

(command "AREA" "O" SurfaceObject)

throws an "<Bad Entity name: 2A9B500>" error and causes infinite behaviour when called inside  a "BLOCK" object (not "INSERT" object) . Before calling "AREA" I filter out non-surface objects to assure "AREA" ist possible to call at all. Applying this method works on all surface objects not in blocks however. Hence there is probably a "BLOCK" specific issue?

[Sea-Haven]

As @Moshe-A hinted you need to look at every object type inside a block then match a surface type.

; By BeekeeZC
(defun c:BlockEnts ( / :block e)
  
  (defun :block (e l)
    (setq l (1+ l))
    (while (setq e (entnext e))
      (princ (strcat "\n" (itoa l) ":"))
      (if (= "INSERT" (princ (cdr (assoc 0 (entget e)))))
	(:block (tblobjname "BLOCK" (cdr (assoc 2 (entget e)))) l))))
  
  (if (setq e (car (entsel "Select block: ")))
    (:block (tblobjname "BLOCK" (cdr (assoc 2 (entget e)))) 0))
  
  (princ)
  )

[varg.zaugg]

@Sea-Haven : Your function checks nested blocks right? I updated it and still got <Bad Entity name: 2A99080> error (only "PLANESURFACE" objects inside block).

(defun c:BlockEntsSurfaceAreas ( / :block e)
  
  (defun :block (e l)
    (setq l (1+ l))

    (while (setq e (entnext e))

      (princ (strcat "\n" (itoa l) ":"))

      (if (= "INSERT" (princ (cdr (assoc 0 (entget e)))))
          (:block (tblobjname "BLOCK" (cdr (assoc 2 (entget e)))) l))
          (if (= "PLANESURFACE" (cdr (assoc 0 (entget e))))
              (progn 
                (command "AREA" "O" e)
                (while (< 0 (getvar 'cmdactive)) (command ""))
              );progn
          )
    )
  )
  
  (if (setq e (car (entsel "Select block: ")))
    (:block (tblobjname "BLOCK" (cdr (assoc 2 (entget e)))) 0))
  
  (princ)
)

Also

(command "AREA" "O" (car (entsel)))

doesn't work (returns nil) in modelspace, thogh command line version works well.

[paullimapa]

To troubleshoot your code I copy & pasted each line to the command line and as you've experienced AutoCAD does not like to use the AREA command to return an object from inside a Block.

So what I did is to revise your code to Explode the Block and then run the Area command on the objects from the exploded Block. The code's current limitation is that it only works on the objects  within Blocks one level deep.

Give it a try.

; get_block_surface_areas
; OP
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/area-command-in-autolisp-not-working-in-block-and-sometimes-in/td-p/13372976
(defun get_block_surface_areas ( / i:BlockObjectName i:BlockObject
                                   i:BlockName i:InsertVLA cmdecho menuecho Total)
(vl-load-com)
  (setq InsertSelectionSet    (ssget '((0 . "INSERT")))
        Counter         -1
        Total            0
        cmdecho  (getvar 'cmdecho) ; save current settings
        menuecho (getvar 'menuecho)        
  );setq
  
(if InsertSelectionSet ; chk if blocks selected
 (progn ; then proceed
   
  (setvar 'menuecho 0) ; turn off echo
  (setvar 'cmdecho 0)
   
  (while (setq i:InsertObject   (ssname InsertSelectionSet (setq Counter (1+ Counter))))

         (setq
            i:InsertVLA       (vlax-ename->vla-object i:InsertObject)
            i:BlockName       (vla-get-effectivename  i:InsertVLA)
            i:BlockObject     (tblobjname "Block"     i:BlockName)
         );setq
    
         (command "_.Undo" "_M") ; mark beginning of undo
         (command "_.Explode" i:InsertObject) ; explode block
         (setq ss (ssget "_P")) ; retrieve all entities from exploded block
    
         (foreach i:BlockObject (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ; begin selection item loop
;         (while (setq i:BlockObject (entnext i:BlockObject))
                (setq i:BlockObjectName (cdr (assoc 0 (entget i:BlockObject))));setq

                (if (or (= i:BlockObjectName  "PLANESURFACE")
                        (= i:BlockObjectName  "NURBSURFACE")
                        (= i:BlockObjectName  "EXTRUDEDSURFACE")
                        (= i:BlockObjectName  "SURFACE")
                        (= i:BlockObjectName  "REGION")
                        (= i:BlockObjectName  "3DSOLID")
                    );or

                    (progn 
                       (command "_.AREA" "_O" i:BlockObject)
;                        (while (< 0 (getvar 'cmdactive)) (command ""))                       
                        (setq Total (+ Total (getvar 'area)))
                    );progn
                );if
;         );while
         ) ; foreach
    
        (command "_.Undo" "_B") ; undo explode of block
    
  );while
   
  (setvar 'menuecho menuecho) ; restore original settings
  (setvar 'cmdecho cmdecho)
   
 ) ; progn
) ; if
 ; return total area as real number
 Total
);get_block_surface_areas 

[paullimapa · Accepted solution]

Ok instead of using the AREA command just use the lisp function:

(getpropertyvalue i:BlockObject "Area")

Here's the revise version but again this only gets one level deep:

; get_block_surface_areas
; OP
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/area-command-in-autolisp-not-working-in-block-and-sometimes-in/td-p/13372976
(defun get_block_surface_areas ( / i:BlockObjectName i:BlockObject
                                   i:BlockName i:InsertVLA Total)
(vl-load-com)
  (setq InsertSelectionSet    (ssget '((0 . "INSERT")))
        Counter         -1
        Total            0
  );setq
  
(if InsertSelectionSet ; chk if blocks selected
 (progn ; then proceed
   
  (while (setq i:InsertObject   (ssname InsertSelectionSet (setq Counter (1+ Counter))))

         (setq
            i:InsertVLA       (vlax-ename->vla-object i:InsertObject)
            i:BlockName       (vla-get-effectivename  i:InsertVLA)
            i:BlockObject     (tblobjname "Block"     i:BlockName)
         );setq
    
         (while (setq i:BlockObject (entnext i:BlockObject))
                (setq i:BlockObjectName (cdr (assoc 0 (entget i:BlockObject))));setq

                (if (or (= i:BlockObjectName  "PLANESURFACE")
                        (= i:BlockObjectName  "NURBSURFACE")
                        (= i:BlockObjectName  "EXTRUDEDSURFACE")
                        (= i:BlockObjectName  "SURFACE")
                        (= i:BlockObjectName  "REGION")
                        (= i:BlockObjectName  "3DSOLID")
                    );or

                    (progn 
;                       (command "_.AREA" "_O" i:BlockObject)
;                        (while (< 0 (getvar 'cmdactive)) (command ""))                                             
;                        (setq Total (+ Total (getvar 'area)))
                        (setq Total (+ Total (getpropertyvalue i:BlockObject "Area")))
                    );progn
                );if
         );while

  );while  
 ) ; progn
) ; if
 ; return total area as real number
 Total
);get_block_surface_areas 

[varg.zaugg]

@pau : Credit goes to you! 😁

However for everyone, who would like to use a simplified function:

; Return area sum of surface entities in Block.

(defun f:GetBlockSurfaceAreas (i:BlockEntity / TotalSurfaceAreas
                               *error* message)
  (defun *error* (message /)
    (princ "\n\t\t f:GetBlockSurfaceAreas function error.")
    (print message) (princ)
  );*error*

  (setq SurfaceType-List  (list
                            "PLANESURFACE" "NURBSURFACE" "EXTRUDEDSURFACE"
                            "SURFACE" "REGION")
        TotalSurfaceAreas 0
  );setq

  (while (setq i:BlockEntity (entnext i:BlockEntity))

         (setq i:BlockObjectName  (cdr (assoc 0 (entget i:BlockEntity))));setq

         (if  (member i:BlockObjectName SurfaceType-List)

              (setq TotalSurfaceAreas
                    (+ TotalSurfaceAreas (getpropertyvalue i:BlockEntity "Area"))) 
         );if

  );while

  (setq TotalSurfaceAreas (* TotalSurfaceAreas 0.0001))
  TotalSurfaceAreas
);f:GetBlockSurfaceAreas

[varg.zaugg]

I've forgotten to call 

(tblobjname "Block" "InsertName")

Now it works:

(defun f:GetBlockSurfaceAreas (InsertEntity / InsertVLA i:BlockEntity TotalSurfaceAreas
                               *error* message)
  (defun *error* (message /)
    (princ "\n\t\t f:GetBlockSurfaceAreas function error.")
    (princ "\n\t\t File: calculation_areas.lsp")
    (print message) (princ)
  );*error*

  (setq SurfaceType-List  (list
                            "PLANESURFACE" "NURBSURFACE" "EXTRUDEDSURFACE"
                            "SURFACE" "REGION")
        TotalSurfaceAreas 0
        InsertVLA         (vlax-ename->vla-object InsertEntity)
        i:BlockEntity     (tblobjname "Block" (vla-get-effectivename InsertVLA))
  );setq

  (while (setq i:BlockEntity (entnext i:BlockEntity))

         (setq i:BlockObjectName  (cdr (assoc 0 (entget i:BlockEntity))));setq

         (if  (member i:BlockObjectName SurfaceType-List)

              (setq TotalSurfaceAreas
                    (+ TotalSurfaceAreas (getpropertyvalue i:BlockEntity "Area"))) 
         );if

  );while

  (setq TotalSurfaceAreas (* TotalSurfaceAreas 0.0001))
  TotalSurfaceAreas
);f:GetBlockSurfaceAreas