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?
Thank's
GPaolo
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
Try
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
Next
'MANTAIN GROUPS
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
Try
NewGroup = HmDotNet.HmTool.AcadDoc.Groups.Item(NameGrp)
Catch
End Try
If NewGroup Is Nothing Then
NewGroup = AcadDoc.Groups.Add(NameGrp)
End If
End If
NewGroup.AppendItems(GroupObj)
Exit For
End If
Next J
Next
NewGroup = Nothing
End If
End If
Next
BlockRef.Delete()
HmDotNet.HmTool.HmPurgeBGL()
Catch ex As Exception
MessageBox.Show(ex.ToString)
Finally
BlockRef = Nothing
Block = Nothing
RetVal = Nothing
End Try
End Sub