command "burst" working .net code

Code Red > .NET

<< < (2/2)

nekitip:
thank you, but check what I found out:

--- Code: ---Autodesk.AutoCAD.Colors.Color.FromEntityColor(_entity_color_to_copy_from_)
--- End code ---
It contains a lot more information, and it looks like it can be copied easily.

So, in this particular case, this may be like:

--- Code - vb.net: ---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

nekitip:
and here is complete "burst" working code
use it for good cause :smitten:

--- Code - vb.net: --- '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

Atook:

--- Quote from: nekitip on January 10, 2019, 03:47:35 PM ---thank you, but check what I found out:

--- Code: ---Autodesk.AutoCAD.Colors.Color.FromEntityColor(_entity_color_to_copy_from_)
--- End code ---
It contains a lot more information, and it looks like it can be copied easily...
--- End quote ---
Ohh, nice, perfect for what you wanted! Thanks for sharing. :-)

Navigation

[0] Message Index

[*] Previous page

Go to full version