.NET

Reply
*GPaolo
Message 1 of 1 (46 Views)

What i can make?

46 Views, 0 Replies
10-13-2006 06:19 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?
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
Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.