Macro for area

[nextvkin]

Hello,
I inherited a menu item with the following macro for finding the area of an object :

*^C^Carea;e;\-mtext;\_none;@1,-1;$m=$(/,$(fix,$(/,$(getvar,area),10000)),100)sqm;;

This works ok in WCS ie the text appears where it's clicked, but in other UCSs the text just goes off somewhere else. Can some macro expert fix it so that it works in any UCS?
TIA,
Kay.

[zoomharis]

If you are using AutoCAD full version, then try the modified macro. It will not work in AutoCAD LT as it contains Lisp expressions.

^C^Carea;e;\-mtext;(setq pnt (getpoint));\!pnt;$m=$(/,$(fix,$(/,$(getvar,area),10000)),100)sqm;;

HTH

[arshiel88]

Alternatively, here's a vba macro that will do the same; plus..

1. Checks if you are working in millimeter ( via ltscale system variable) so that it will not give you an area in square millimeter.
and;
2.put the area to clipboard for pasting later (say in excel table).

Sub AreaText()

Dim ClipData As New DataObject

Dim returnObj As AcadObject
Dim basePnt, RetPoint As Variant
Dim NewText As AcadText
Dim Area As Variant
Dim txtStyleObj As AcadTextStyle
    Set txtStyleObj = ThisDrawing.ActiveTextStyle
   
 On Error Resume Next
      ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select Object to Calculate..."
        If Err <> 0 Then
        Err.Clear
        
        Exit Sub
    Else
    
    If returnObj.Area = "" Then
        MsgBox "Object is a " & Mid(returnObj.ObjectName, 5, 30) & " and it doesn't have an area."
        Exit Sub
    End If

  'MsgBox returnObj.ObjectName
  CurrHeight = txtStyleObj.LastHeight
  currltscale = ThisDrawing.GetVariable("LTSCALE")
  If currltscale < 100 Then
        Area = Format(returnObj.Area, "#,###.00 SQ. M.")
         
        'MsgBox "The current value for Area is " & Area & "."
   Else
        Area = Format((returnObj.Area / 1000000), "#,###.00 SQ. M.")
        
  End If
  
  ClipData.SetText (Format(returnObj.Area, "#,###.00"))
  ClipData.PutInClipboard

  RetPoint = ThisDrawing.Utility.GetPoint(, "Area is " & Area & vbCrLf & "Pick point where text is to be inserted...")
  
  Set NewText = ThisDrawing.ModelSpace.AddText(Area, RetPoint, CurrHeight)
  NewText.Layer = "Text"
  ThisDrawing.SendCommand "justifytext" & vbCr & "l" & vbCr & vbCr & "m" & vbCr
  
End If

End Sub

Note: This tool adapts the height of the last created text.

[nextvkin]

Thanks for fixing the macro, Haris, it works perfectly.
As for the VBA, I'll save it for later - when I find out how to use it. Is it like using a lisp routine which has to be apploaded etc?
Kay.

[mmccarter]

We have a routine written in house for calculating areas.

Much of our work is calculating Net Internal Areas of office buildings. A 10 sq ft error can cost tens of thousands of pounds over a 25 year lease so it is paramount we get it right.
Unfortunately this is not just a perimeter it also involves columns, restricted headroom etc as well which has to be removed from the area.

Our routine allows the user to click on as many closed polylines that they want to to add to the area. Every entity that is clicked changes colour so that there is no duplication or repeat clicks. The user then clicks on all the closed polylines which need to be removed from the area (columns etc) which are highlighted in a different colour.
The user then clicks on a piece of text which is changed to what ever the sq m area value is and does the same for another piece of text for the sq ft.

We are currently investigating taking this a step further to make use of attirbutes/tables etc but are not sure if it is possible to achieve what we want to or not.
We want to link hatches to cells in a table which update dynamically. Out main issue is that on some more intricate buildings we have problems hatching certain shapes and Autocad will not actually hatch an area. Until we solve this we dont think our aim of complete automation can be achieved.

Any ideas?
edit: I really should start a new topic but as this is relavant somewhat to the OP I will leave it here.

[arshiel88]

...Is it like using a lisp routine which has to be apploaded etc?
Kay.

Yes. And like the lisp you can put the macro in a toolbar button in such a way that It will load automatically when needed. (No need to appload/vbaload).

...We are currently investigating taking this a step further to make use of attirbutes/tables etc but are not sure if it is possible to achieve what we want to or not.
We want to link hatches to cells in a table which update dynamically. Out main issue is that on some more intricate buildings we have problems hatching certain shapes and Autocad will not actually hatch an area. Until we solve this we dont think our aim of complete automation can be achieved.

Any ideas?

I think this can be possible via Database programming in VBA but I'll leave that to the experts to discuss. As for the areas that won't hatch, I would recommend to use regions instead of hatches, and subtract everything that is not needed (e.g. columns, voids, etc.) The advantage of this is in regions you can join/add,subtract, and maybe intersect(if needed) while in hatch, you can't, with the exception of trimming. (which in some circumstances doesn't work.)

[zoomharis]

Every entity that is clicked changes colour so that there is no duplication or repeat clicks.

I suggest you to check the handle property of the object rather than using colous. The advantage of this method is that, even if you make a duplicate selection, the program will handle it. Your current method depends upon the operator using it.

We want to link hatches to cells in a table which update dynamically. Out main issue is that on some more intricate buildings we have problems hatching certain shapes and Autocad will not actually hatch an area. Until we solve this we dont think our aim of complete automation can be achieved.

In that case, you can show the area of container object (In your case, closed polylines) instead of hatch area.

[nextvkin]

If you are using AutoCAD full version, then try the modified macro. It will not work in AutoCAD LT as it contains Lisp expressions.


HTH

A year later...it's been a great help, I've been using your modified macro successfully for a year now in FULL ACAD, but now I need it for LT; are you (or anyone) able to modifiy the original macro so it'll work in LT ie without the lisp expression? Thanks.
Kay

[mmccarter]

I suggest you to check the handle property of the object rather than using colous. The advantage of this method is that, even if you make a duplicate selection, the program will handle it. Your current method depends upon the operator using it.


In that case, you can show the area of container object (In your case, closed polylines) instead of hatch area.

The routine does both. It changes the colour so the user doesn't waste time trying to click the same object twice, but at the same time it also will not add the area again if the object is clocked more than once.

Unfortunately it is not possible to use the closed polyline for obtaining the area from it's properties. The area we are after nearly always has deductions to be made from columns or cores of buildings etc aswell - hence our routine of adding/subtracting areas by clicking on objects seems to be the best solution available.

[jaberwok]

Converting the outer polylines minus the inner polylines into Regions might help then.