Use Formula and object area in VBA.

[bme.dgmr]

Hi All,

I've made a little VBA script which let me select a polyline and it gives me a MText block with the area of the polyline attached. This was with a precision of 1 decimal. 

See the code:

Set NewText = ThisDrawing.ModelSpace.AddMText(RetPoint, 0, "%<\AcObjProp.16.2 Object(%<\_ObjId " & returnObj.ObjectID & ">%).Area \f " & "%lu2%pr1%ds44%ct8[1.0E-006]%th46" & ">%" & " m²")

I'd like to round the area to 5 m².

On different forums I've read we can use te Round((xx/5)*5). This works if I do it in Autocad itself.

%<\AcExpr (round(%<\_FldPtr 1846094436224>%/(5*10^6))*5) \f "%ps[, m²]">%

I think 1846... is the ObjectID from the selected Polyline.

But if I will use this as a string in VBA the field gives ### when I give this statement:

RetVal = "%<AcExpr (round((%<\_FldPtr " & returnObj.ObjectID & ">%/(5*10^6)*5)>%"

Does anyone know if it is possible to do in VBA?

Thanks in advance.

Greetz Bjørn

[Ed__Jobe]

I found 2 problems. First, the caret ^ is not recognized in the field formula. I substituted 10^6 with 1000000 and it worked. The second problem is format of the round function. Carefully note the placement of parenthesis. This worked for me:

%<\AcExpr (round (%<\_FldPtr 2487356387792>%/(5*1000000))*5) \f "%lu2%pr2">%

BTW, the VBA forum is over here.

[bme.dgmr]

Hello Ed,

Thanks for the first check, but it still isn't working. The ObjectID will be skipped in the formula.

If I add the text it gives #### and after Double click on the field this is what is said in the screen:

The code for the objectID ( _FldPtr ...) is disappearerd. 

Thanx in advance,

Greetz Bjørn

[grobnik]

Hi @bme.dgmr 

I discovered a post on last 2005 https://forums.autodesk.com/t5/visual-basic-customization/rounding-off-decimals/m-p/1417481/highligh...

where mainly have been asked how to round off 2.66789456123e-11 to 2.668e-11.

Dim d As Double
Dim d1 As Double
Dim ds As String
Dim dv

d = 50 ^ 10
ds = d
dv = VBA.Split(ds, "E", , vbTextCompare)
d1 = VBA.Round(dv(0), 3) & "E" & dv(1)

Debug.Print d
Debug.Print d1

 May be this should work for you.. honestly I did'n check...

Let us know

[bme.dgmr]

Hi,

Thanks for answering my question, but this way for rounding isn't an option for me.

I need the field to stay updated and if I add it as a string it's just "stupid" text and won't adjust if I change my closed polyline.

Greetz Bjørn  

[bme.dgmr]

Hi All, 

Just to be sure hereby my complete code:

Sub AreaText()

Dim returnObj As AcadObject
Dim basePnt, RetPoint As Variant
Dim NewText As AcadMText
Dim Area As Variant
Dim objLength As Variant
Dim txtStyleObj As AcadTextStyle
Dim CurrHeight As Variant
Dim currltscale As Variant
Dim RetVal As String
  
  Set txtStyleObj = ThisDrawing.ActiveTextStyle
   
  ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select Object to Calculate..."
    
  CurrHeight = txtStyleObj.LastHeight
  currltscale = ThisDrawing.GetVariable("LTSCALE")
  If currltscale < 100 Then
        Area = Format(returnObj.Area / 1000000, "#,### m²")
        objLength = Format(returnObj.Length / 1000, "#,### m¹")
        'MsgBox "The current value for Area is " & Area & "."
   Else
        Area = Format(returnObj.Area / 1000000, "#,### m²")
        objLength = Format(returnObj.Length / 1000, "#,### m¹")
  End If
    
  RetPoint = ThisDrawing.Utility.GetPoint(, "Area is " & Area & vbCrLf & "Length is " & objLength & vbCrLf & "Pick point where text is to be inserted...")
  If returnObj.Closed = True Then
    RetVal = "%<\AcExpr round(%<\_FldPtr " & returnObj.ObjectID & ">%/5000000)*5>%"
    'Set NewText = ThisDrawing.ModelSpace.AddMText(RetPoint, 0, "%<\AcObjProp.16.2 Object(%<\_ObjId " & returnObj.ObjectID & ">%).Area \f " & "%lu2%pr1%ds44%ct8[1.0E-006]%th46" & ">%" & " m²")
    Set NewText = ThisDrawing.ModelSpace.AddMText(RetPoint, 0, RetVal)
    Debug.Print RetVal
  Else
    Set NewText = ThisDrawing.ModelSpace.AddMText(RetPoint, 0, "%<\AcObjProp.16.2 Object(%<\_ObjId " & returnObj.ObjectID & ">%).Length \f " & "%lu2%pr1%ct8[0.001]" & ">%" & " m¹")
  End If
    NewText.BackgroundFill = True
    NewText.Height = Right(ThisDrawing.GetVariable("cannoscale"), 3) * ThisDrawing.GetVariable("textsize")
    NewText.Layer = returnObj.Layer
    'NewText.Alignment = acAlignmentTopLeft
    Debug.Print NewText.TextString
    ThisDrawing.Utility.Prompt NewText.TextString & vbCrLf

End Sub

Thanx in advance.

Greetz Bjørn

[grobnik]

Hi @bme.dgmr thank you for your answer, I'm sorry for my previously post, probably I have not understood well the issue, as well I'm more or less sure that what I'm showing you below doesn't match exactly with what do you need.

Probably you can solve your issue with extracting from below code the part of Handent that is way (coming from LSP) to pass some reference to a text. I used in order to fillet two lines using send command.

This is not a field but it's a reference to object.

text = "_FILLET" & vbCr & "R" & vbCr & Radius & vbCr & "(handent " & Chr(34) & Line1.Handle & Chr(34) & ") " & vbCr & "(handent " & Chr(34) & Line2.Handle & Chr(34) & ") "
ThisDrawing.SendCommand (text)

 I'm not so expert with LSP.

I hope this could help you to find and discovery the right way.

[Ed__Jobe]

You didn't pay attention to the location of parenthesis like I mentioned. See my corrections below.

---

@bme.dgmr wrote:

Hi All, 

Just to be sure hereby my complete code:

Sub AreaText()

Dim returnObj As AcadObject
Dim basePnt, RetPoint As Variant
Dim NewText As AcadMText
Dim Area As Variant
Dim objLength As Variant
Dim txtStyleObj As AcadTextStyle
Dim CurrHeight As Variant
Dim currltscale As Variant
Dim RetVal As String
  
  Set txtStyleObj = ThisDrawing.ActiveTextStyle
   
  ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select Object to Calculate..."
    
  CurrHeight = txtStyleObj.LastHeight
  currltscale = ThisDrawing.GetVariable("LTSCALE")
  If currltscale < 100 Then
        Area = Format(returnObj.Area / 1000000, "#,### m²")
        objLength = Format(returnObj.Length / 1000, "#,### m¹")
        'MsgBox "The current value for Area is " & Area & "."
   Else
        Area = Format(returnObj.Area / 1000000, "#,### m²")
        objLength = Format(returnObj.Length / 1000, "#,### m¹")
  End If
    
  RetPoint = ThisDrawing.Utility.GetPoint(, "Area is " & Area & vbCrLf & "Length is " & objLength & vbCrLf & "Pick point where text is to be inserted...")
  If returnObj.Closed = True Then
    'Corrected line below. Added 1-( and 1-)
    RetVal = "%<\AcExpr (round(%<\_FldPtr " & returnObj.ObjectID & ">%/5000000)*5)>%"
    'Set NewText = ThisDrawing.ModelSpace.AddMText(RetPoint, 0, "%<\AcObjProp.16.2 Object(%<\_ObjId " & returnObj.ObjectID & ">%).Area \f " & "%lu2%pr1%ds44%ct8[1.0E-006]%th46" & ">%" & " m²")
    Set NewText = ThisDrawing.ModelSpace.AddMText(RetPoint, 0, RetVal)
    Debug.Print RetVal
  Else
    Set NewText = ThisDrawing.ModelSpace.AddMText(RetPoint, 0, "%<\AcObjProp.16.2 Object(%<\_ObjId " & returnObj.ObjectID & ">%).Length \f " & "%lu2%pr1%ct8[0.001]" & ">%" & " m¹")
  End If
    NewText.BackgroundFill = True
    NewText.Height = Right(ThisDrawing.GetVariable("cannoscale"), 3) * ThisDrawing.GetVariable("textsize")
    NewText.Layer = returnObj.Layer
    'NewText.Alignment = acAlignmentTopLeft
    Debug.Print NewText.TextString
    ThisDrawing.Utility.Prompt NewText.TextString & vbCrLf

End Sub

Thanx in advance.

Greetz Bjørn

---

[bme.dgmr]

Hi Ed,

Thanks for your response. Unfortunately it still doesn't fix my problem.

I still got this empty place where the ObjectID should be.

Greetz Bjørn

[Ed__Jobe]

I figured out what the problem is. Unfortunately, I don't have a solution in VBA. The problem is that you are trying to build a string just from the objectID of the polyline, but what you need is a nested field. First you have to build an ObjectID field pointing to the polyline and then you need to build a formula field that uses the OjbectID of the previous field, not the ObjectID of the polyline. The problem  is that VBA doesn't have an api to directly create a field, so I don't know how to get an ObjectID of something that has not been created yet. I tried the following, but it's not a valid syntax. It needs to look like the original code I gave you, but I can only get a FldPtr using the dialog.

RetVal = "%<\\_AcExpr (round(%<\\_AcObjProp Object(%<\\_ObjId " & returnObj.ObjectID & ">%).Area/5000000)*5)>%"

I could do it in C#, but I don't see a way in VBA...at least not at the moment. I'll think about it.

[bme.dgmr]

Hi @Ed__Jobe,

Thanks. You've just mentioned where I was afraid of.😉

I also thought it isn't possible to nest a field in a field with VBA.

I'm curious if you can find a wokaround.

Thanks in advance.

Greetz, Bjørn

[Ed__Jobe]

Does it have to be in VBA? I can do it in C#.