'copy properties of DBText type objects from one to other
'this works for DBText, AttRed, AttDef
Private Shared Sub fillTextFromText(ByRef blockRef As BlockReference, ByRef textFrom As DBText, ByRef textTo As DBText)
textTo.Height = textFrom.Height
textTo.Position = textFrom.Position
textTo.Rotation = textFrom.Rotation
textTo.TextString = textFrom.TextString
textTo.TextStyleId = textFrom.TextStyleId
textTo.WidthFactor = textFrom.WidthFactor
textTo.VerticalMode = textFrom.VerticalMode
textTo.HorizontalMode = textFrom.HorizontalMode
textTo.Normal = textFrom.Normal
textTo.Thickness = textFrom.Thickness
textTo.Oblique = textFrom.Oblique
textTo.IsMirroredInX = textFrom.IsMirroredInX
textTo.IsMirroredInY = textFrom.IsMirroredInY
textTo.Transparency = textFrom.Transparency
textTo.Justify = textFrom.Justify
'possible bug in autocad when "MIDDLE" is used; text.rotation sometimes gets to be math.pi, sometimes not, and text is inserted in dwg to zero, no mater position
'noticed on autocad 2020 (acad2020) dynamic block with flip parameter, and can be produced if parameter is set to justify to Middle, simply by hand in block editor
'the main issue with this is here: - alignment point is not at its default position, but isdefaultposition flag is not set. It would be expected to be.
'However, If alignment point if not set during copy (when off 0,0,0), then it will go at zero position od model space.
'Applying alignment point at any other time is enotaplicable error (and a crash)
'the current only solution I came to is to check if text is in any nonleft mode and change point only then
If Not (textFrom.HorizontalMode = TextHorizontalMode.TextLeft) Then
textTo.AlignmentPoint = textFrom.AlignmentPoint
End If
'copy colors (all) and layers (only layer 0 is replaced)
'later, get colors and other from block (overwrite)
textTo.SetPropertiesFrom(textFrom)
End Sub
Private Shared Sub explodeBlock(btr As BlockTableRecord, blockDef As BlockTableRecord, trans As Transaction, blockRef As BlockReference)
Using explodedObjects As New DBObjectCollection
Dim toAddColl As DBObjectCollection = New DBObjectCollection()
For Each entId As ObjectId In blockDef
If entId.ObjectClass.Name = "AcDbAttributeDefinition" Then
Dim attDef As AttributeDefinition = trans.GetObject(entId, OpenMode.ForRead)
If (attDef.Constant AndAlso Not attDef.Invisible AndAlso attDef.Visible) Then 'maybe no need for visible check here?
If attDef.IsMTextAttributeDefinition Then
Dim text As MText = New MText()
text.CopyFrom(attDef.MTextAttributeDefinition) 'no new(), so no need to dispose later?
'looks like TransformBy is needed here
'in some examples, only point is transformedby
text.TransformBy(blockRef.BlockTransform)
toAddColl.Add(text)
Else
Dim text As DBText = New DBText()
fillTextFromText(blockRef, attDef, text)
'looks like TransformBy is needed here
'in some examples, only point is transformedby
text.TransformBy(blockRef.BlockTransform)
toAddColl.Add(text)
End If
End If
End If
Next
For Each attRefId As ObjectId In blockRef.AttributeCollection
Dim attRef As AttributeReference = trans.GetObject(attRefId, OpenMode.ForRead)
If attRef.Invisible = False AndAlso attRef.Visible Then 'bizzare, but attref in dynblock in visstate can be invisible=false, and visible=false
If attRef.IsMTextAttribute Then
Dim mt As MText = attRef.MTextAttribute 'no new, so no dispose?
Dim text As MText = New MText()
text.CopyFrom(mt)
toAddColl.Add(text)
Else
Dim textD As DBText = New DBText()
fillTextFromText(blockRef, attRef, textD)
toAddColl.Add(textD)
End If
End If
Next
'explode all to single new objects
'objects need to be added in db, however, filter unvisible objects (if dynamic block)
blockRef.Explode(explodedObjects)
For Each ent As Entity In explodedObjects
If Not (ent.GetType = GetType(AttributeDefinition)) AndAlso ent.Visible Then toAddColl.Add(ent)
Next
'add all to drawing, and get colors and layer from block (but if color is nonzero, leave color as it was)
'SetPropertiesFrom will set layers 0 but color is overwritten...
For Each ent As Entity In toAddColl
If ent.Layer = "0" Then
Dim entColOriginal = ent.Color.EntityColor
ent.SetPropertiesFrom(blockRef)
If entColOriginal.ColorIndex > 0 Then ent.Color = Autodesk.AutoCAD.Colors.Color.FromEntityColor(entColOriginal)
End If
btr.AppendEntity(ent)
trans.AddNewlyCreatedDBObject(ent, True)
Next
'delete old block (if not, it would show up in drawing at the same place)
blockRef.UpgradeOpen()
blockRef.Erase()
End Using
End Sub