.NET
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

lost xdata or groups

0 REPLIES 0
Reply
Message 1 of 1
Anonymous
271 Views, 0 Replies

lost xdata or groups

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
0 REPLIES 0

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk DevCon in Munich May 28-29th


Autodesk Design & Make Report

”Boost