Message 1 of 1
Polyline Area to block Attribute

Not applicable
12-10-2006
07:38 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello!
I wrote a vba macro which copies the field expression for polyline area into the attribute field of a block reference.
It all seems to work fine but as soon as you scale the block (not the actuall polyline) the area changes! Another problem is that when i xref the drawing with that block into another drawing the area displays 0,00 after i regenerate the drawing.
code for adding field expression to attribute string value
Public Const strLeftOfIDValue = "%<\AcObjProp.16.2 Object(%<\_ObjId "
Public Sub subAddAttributesToBlock(TargetBlock As AcadBlockReference, ePolyline As AcadEntity)
Dim varAttribs As Variant 'container fo block reference attributes
Dim strAreaAttributeValue As String 'string containing the link to polyline object's area
Const sSource = "Error In subAddAttributesToBlock" 'string containing the error message for this sub
'activate error handling
On Error GoTo ERROR_HANDLER
'create link to area of polyline
strAreaAttributeValue = strLeftOfIDValue + CStr(ePolyline.ObjectID) + _
">%,1).Area \f " + Chr(34) + "%lu2%pr2%ps[,m2]%ct8[0.0000000001]" + Chr(34) + ">%"
' add attributes to block reference
For Each varAttribs In TargetBlock.GetAttributes
Select Case varAttribs.TagString
Case strTagPolylineID
varAttribs.TextString = strAreaAttributeValue
End Select
Next
'leave sub
Exit Sub
Any help would be appreciated!
Jan
I wrote a vba macro which copies the field expression for polyline area into the attribute field of a block reference.
It all seems to work fine but as soon as you scale the block (not the actuall polyline) the area changes! Another problem is that when i xref the drawing with that block into another drawing the area displays 0,00 after i regenerate the drawing.
code for adding field expression to attribute string value
Public Const strLeftOfIDValue = "%<\AcObjProp.16.2 Object(%<\_ObjId "
Public Sub subAddAttributesToBlock(TargetBlock As AcadBlockReference, ePolyline As AcadEntity)
Dim varAttribs As Variant 'container fo block reference attributes
Dim strAreaAttributeValue As String 'string containing the link to polyline object's area
Const sSource = "Error In subAddAttributesToBlock" 'string containing the error message for this sub
'activate error handling
On Error GoTo ERROR_HANDLER
'create link to area of polyline
strAreaAttributeValue = strLeftOfIDValue + CStr(ePolyline.ObjectID) + _
">%,1).Area \f " + Chr(34) + "%lu2%pr2%ps[,m2]%ct8[0.0000000001]" + Chr(34) + ">%"
' add attributes to block reference
For Each varAttribs In TargetBlock.GetAttributes
Select Case varAttribs.TagString
Case strTagPolylineID
varAttribs.TextString = strAreaAttributeValue
End Select
Next
'leave sub
Exit Sub
Any help would be appreciated!
Jan