Topic: Where am I going wrong - Fields to areas (polylines).

[Matersammichman]

I am trying to write a vba routine that will allow me to apply Fields to areas (polylines). I've tried numerous methods, but keep getting ####. I'm trying not to use regions and boundaries. Where am I going wrong?
2007 CAD

Code: [Select]

Private Sub CommandButton5_Click()
    Me.hide
Dim Mytext As AcadText
Dim entarea As Double
Dim textObj As AcadEntity
Dim text As String
Dim fieldcode As String
Dim insertionPoint(0 To 2) As Double
Dim height As Double
Dim NewArea As Double
Dim OBJID As Variant
Dim objEnt As AcadEntity
Dim varPick As Variant
Dim TXTID2 As AcadText
Dim entObjectID As Long
Dim sysVarName As Variant
Dim VARDATA As Variant
Dim returnpnt As Variant
sysVarName = "dimscale"
VARDATA = ThisDrawing.GetVariable(sysVarName)
    Dim plineObj As AcadLWPolyline
    Dim plineArea As Double

ThisDrawing.Utility.GetEntity objEnt, varPick, vbCr & "Select object for Area: "
entObjectID = objEnt.ObjectID
Set plineObj = objEnt
MsgBox "The ObjectID of this object is " & entObjectID, vbInformation, "ObjectID Example"
plineArea = (plineObj.Area \ 144)
MsgBox "The area is: " & plineArea, vbInformation, "Area Example"
returnpnt = ThisDrawing.Utility.GetPoint(, "Select Block Insertion Point: ")
height = Val(VARDATA * 0.09375) 'fixED to 3/32
'%<\AcObjProp Object(%<\_ObjId 1916720304>%).Area>%
text = "%<\AcObjProp plineArea(%<\_entojectid>%).Area>%"
'text = "%<\AcObjProp plineArea \f>%"
MsgBox "The Square Footage for the selected entity equals: " & fieldcode, vbInformation, "FieldCode Example"
Set textObj = ThisDrawing.ModelSpace.AddText(text, returnpnt, height) 'must use fieldcode
text = textObj.fieldcode
End Sub

edit jonesy... thread title changed/added code pane

[Guest]

Try editing the text, then select the EDIT FIELD.   When I do it, it says *Unknown*.  So the code for the field is wrong somewhere.

[Matersammichman]

Thanks. I'd already tried that too.

[Fatty]

Try AddMText instead

~'J'~

[Guest]

Try AddMText instead

~'J'~

Why would it make a difference if he used MText instead of Text?

[LE]

the problem or error is in this line:

text = "%<\AcObjProp plineArea(%<\_entojectid>%).Area>%"

i don't do vb/a but try to change the field code to something:

text = "%<\AcObjProp Object(%<\_ObjId 2130318016>%).Area>%"

as you have in some place on your code un comment...

[LE]

or try/test with this:

text = "%<\AcObjProp Object(%<\_ObjId " + Str$(entObjectID) + ">%).Area>%"

that will add the field value....

[Matersammichman]

...still won't work.

[LE]

...still won't work.

Strange... here is the code I tested... (I just did minor changes to your original code)

Code: [Select]

Public Sub AddAreaField()
Dim Mytext As AcadText
Dim entarea As Double
Dim textObj As AcadEntity
Dim text As String
Dim fieldcode As String
Dim insertionPoint(0 To 2) As Double
Dim height As Double
Dim NewArea As Double
Dim OBJID As Variant
Dim objEnt As AcadEntity
Dim varPick As Variant
Dim TXTID2 As AcadText
Dim entObjectID As Long
Dim sysVarName As Variant
Dim VARDATA As Variant
Dim returnpnt As Variant
sysVarName = "dimscale"
VARDATA = ThisDrawing.GetVariable(sysVarName)
    Dim plineObj As AcadLWPolyline
    Dim plineArea As Double

ThisDrawing.Utility.GetEntity objEnt, varPick, vbCr & "Select object for Area: "
entObjectID = objEnt.ObjectID
Set plineObj = objEnt
MsgBox "The ObjectID of this object is " & entObjectID, vbInformation, "ObjectID Example"
plineArea = (plineObj.Area \ 144)
MsgBox "The area is: " & plineArea, vbInformation, "Area Example"
returnpnt = ThisDrawing.Utility.GetPoint(, "Select Block Insertion Point: ")
height = Val(VARDATA * 0.09375) 'fixED to 3/32

text = "%<\AcObjProp Object(%<\_ObjId " + Str$(entObjectID) + ">%).Area>%"

'text = "%<\AcObjProp plineArea \f>%"
MsgBox "The Square Footage for the selected entity equals: " & fieldcode, vbInformation, "FieldCode Example"

Set textObj = ThisDrawing.ModelSpace.AddText(text, returnpnt, height) 'must use fieldcode
'Set textObj = ThisDrawing.ModelSpace.AddMText(returnpnt, height, text) 'must use fieldcode
text = textObj.fieldcode
End Sub


[Matersammichman]

It chokes at-
Str$

What's causing that?

[LE]

It chokes at-
Str$

What's causing that?

I ran the macro/function inside of AutoCAD 2007 - and it is working

as I said, I am not a VB/A programmer

[Fatty]

Hi
This worked for me too in A2007eng

Code: [Select]

Private Sub CommandButton5_Click()
Me.hide


Dim Mytext As AcadMText
Dim entarea As Double
Dim textObj As AcadEntity
Dim text As String
Dim fieldcode As String
Dim insertionPoint(0 To 2) As Double
Dim height As Double
Dim NewArea As Double
Dim OBJID As Variant
Dim objEnt As AcadEntity
Dim varPick As Variant
Dim TXTID2 As AcadText
Dim entObjectID As Long
Dim sysVarName As Variant
Dim VARDATA As Variant
Dim returnpnt As Variant
sysVarName = "dimscale"
VARDATA = ThisDrawing.GetVariable(sysVarName)
Dim plineObj As AcadLWPolyline
Dim plineArea As Double

ThisDrawing.Utility.GetEntity objEnt, varPick, vbCr & "Select object for Area: "
entObjectID = objEnt.ObjectID
Set plineObj = objEnt
'//MsgBox "The ObjectID of this object is " & entObjectID, vbInformation, "ObjectID Example"
plineArea = plineObj.Area / 144
MsgBox "The area is: " & Format(CStr(plineArea), "0.00000"), vbInformation, "Area Example"
returnpnt = ThisDrawing.Utility.GetPoint(, "Select Block Insertion Point: ")

height = CDbl(VARDATA * 0.09375) 'fixED to 3/32

text = " %<\AcObjProp Object(%<\_ObjId " & CStr(entObjectID) & ">%).Area \f " & Chr(34) & "%lu2%ct4%qf1 SQ. FT." & Chr(34) & ">%"

'//MsgBox "The Square Footage for the selected entity equals: " & fieldcode, vbInformation, "FieldCode Example"
Set Mytext = ThisDrawing.ModelSpace.AddMText(returnpnt, 0#, text)   'must use fieldcode
Mytext.height = height
ThisDrawing.Regen acActiveViewport
text = Mytext.fieldcode
MsgBox text
Me.Show
End Sub

~'J'~

[Guest]

Worked for me in MEP 2008.

One thing I did notice was that if your current dimstyle was set as ANNOTATIVE it wouldn't work because the dimscale for an annotative dimension style is 0.

[Matersammichman]

Got it, thanks.
The problem was missing refernces.