lost xdata or groups

120 Views, 0 Replies
10-09-2006 05:55 AM
I need to insert a block that contain entity on various layer that have
xdata and groups and put any entity on the original layer.
If use the command _insert and selct explode i lost any xdata and groups.
To mantain thi information i must make _insert and after _explode .
In this way a mantain the information.

With Com Interop i have write the routine that make this job but with DOTNET
API is ,for me ,impossible.
Some help?
Public Overloads Shared Sub HmInsPart(ByVal InsertionPnt As AcGe.Point3d,
ByRef NameDwg As String, ByRef ScaleX As Double, ByRef ScaleY As Double,
ByRef ScaleZ As Double, ByRef Rot As Double, ByRef lay As String)

Dim Block As AcIuC.AcadBlock

Dim BlockRef As AcIuC.AcadBlockReference

Dim p1(2) As Double

Dim INSPNT(2) As Double

Dim CollObj() As AcIuC.AcadObject

Dim Obj As AcIuC.AcadObject

Dim RetVal As Object

Dim IDPairs As Object = Nothing

Dim J As Long

If Not HmDotNet.HmFunc.FileExist(NameDwg) Then

MessageBox.Show("DWG named = " & NameDwg & " not found!", "Haarmann
Information", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)

Exit Sub

End If


INSPNT(0) = InsertionPnt.X

INSPNT(1) = InsertionPnt.Y

INSPNT(2) = InsertionPnt.Z

p1(0) = 0

p1(1) = 0

p1(2) = 0

BlockRef = HmDotNet.HmTool.AcadDoc.ModelSpace.InsertBlock(INSPNT, NameDwg, _

ScaleX, ScaleY, ScaleZ, HmDotNet.HmFunc.DegRad(Rot))

Block = HmDotNet.HmTool.AcadDoc.Blocks.Item(BlockRef.Name)

J = -1

ReDim CollObj(Block.Count - 1)

For Each Obj In Block

J += 1

CollObj(J) = Obj

Next Obj

RetVal = HmDotNet.HmTool.AcadDoc.CopyObjects(CollObj, _

HmDotNet.HmTool.AcadDoc.ModelSpace, IDPairs)

For J = 0 To UBound(RetVal)

Obj = RetVal(J)

Obj.ScaleEntity(p1, ScaleX)

Obj.Move(p1, INSPNT)

Obj.Rotate(INSPNT, HmDotNet.HmFunc.DegRad(Rot))

If CInt(lay) > 0 Then

Obj.layer = lay

End If



Dim gr As AcIuC.AcadGroup

Dim grps As AcIuC.AcadGroups

Dim Ent As AcIuC.AcadEntity

Dim GroupObj(0) As AcIuC.AcadObject

Dim NewGroup As AcIuC.AcadGroup = Nothing

Dim NameGrp As String

grps = HmDotNet.HmTool.AcadDoc.Groups

For Each gr In grps

If gr.Name.IndexOf("*") <> -1 Then

If gr.Count > 0 Then

For Each Ent In gr

For J = 0 To UBound(IDPairs)

If IDPairs(J).key = Ent.ObjectID Then

GroupObj(0) = HmDotNet.HmTool.AcadDoc.ObjectIdToObject(IDPairs(J).value)

If NewGroup Is Nothing Then

Select Case Ent.Layer

Case "100"

NameGrp = HmNomeGruppo("Profilo")

Case "101"

NameGrp = HmNomeGruppo("Cuore")

Case Else

NameGrp = HmNomeGruppo("Free")

End Select


NewGroup = HmDotNet.HmTool.AcadDoc.Groups.Item(NameGrp)


End Try

If NewGroup Is Nothing Then

NewGroup = AcadDoc.Groups.Add(NameGrp)

End If

End If


Exit For

End If

Next J


NewGroup = Nothing

End If

End If




Catch ex As Exception



BlockRef = Nothing

Block = Nothing

RetVal = Nothing

End Try

End Sub
Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Are you interested in helping shape the future of the Autodesk Community? To participate in this brief usability study, please click here. Your time and input is greatly appreciated!