MANTAIN THE GROUPS AFTER INSERT BLOCK

[Anonymous]

hello.


i use acad2006

I have a part named part1.dwg that contain some enities that are grouped in
the group test now i want
make a insertblock and explode it but i want mantain the previos group.

If i make this operation by line command without automatik explode and that
explode by command all is ok.
But if i make the same operation by program don't work.

----------------------------------------------------
First version:
Try

p1(0) = 0

p1(1) = 0

p1(2) = 0

BlockRef = AcInt.AcadDoc.ModelSpace.InsertBlock(p1, "c:\part1.dwg"1, 1, 0.0)

Block = AcInt.AcadDoc.Blocks.Item(BlockRef.Name)

BlockRef.Explode()

BlockRef.Delete()

Block.Delete()

Catch ex As Exception

MessageBox.Show(ex.Message)

Finally

AcInt.AcadApp.ZoomExtents()

BlockRef = Nothing

Block = Nothing

End Try

'---------------------------

second version

This version have work until acad2005

now don't work

'----------------------------------

Try

p1(0) = 0

p1(1) = 0

p1(2) = 0

BlockRef = AcInt.AcadDoc.ModelSpace.InsertBlock(p1, "c:\part1.dwg",1, 1,
0.0)

Block = AcInt.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 = AcInt.AcadDoc.CopyObjects(CollObj, AcInt.AcadDoc.ModelSpace, )

For J = 0 To UBound(RetVal)

Obj = RetVal(J)

Obj.ScaleEntity(p1, scalex)

Obj.Move(p1, insertionpnt)

Obj.Rotate(insertionpnt, degrad(rot))

Next

BlockRef.Delete()

Block.Delete()

Catch ex As Exception

MessageBox.Show(ex.Message)

Finally

AcInt.AcadApp.ZoomExtents()

BlockRef = Nothing

Block = Nothing

RetVal = Nothing

End Try

------------------------------------------------------

is possible changed the ownerid of the enities in the blockdefinition and
put modelspace?



Now both the solution dont work.

Some help?

[Anonymous]

Not sure what you are asking. Does the blockref that you are inserting contain nested blocks or actually a group?

[Anonymous]

actualy contain a group.
after the insert and explode by one of the two method i dont find never the
group.
If i make by line command insert block and after the insert make the command
explode i find my original group.
Thank's GPaolo

ha scritto nel messaggio news:5022852@discussion.autodesk.com...
Not sure what you are asking. Does the blockref that you are inserting
contain nested blocks or actually a group?

[Anonymous]

I thought Jeff Mishler would answer this, any way below is adapted from his copy function. Since you explode the block I thought you might rather just copy the objects instead. If you add a group to a block then explode the blockref (in cad) it kills the group, but like you said if you insert the block from another drawing and explode it, it stays as a group. Another mystery. I don't know enough about lisp and reactors to figure that out but in VBA there seems to be no info available to tell if an entity is part of a group.
Sub GetBlockItems(strDwgName As String, Optional Pt As Variant)
'Requires a reference to Autocad/ObjectDbx Common library
Dim dbxDoc As AxDbDocument
If Int(Left(ThisDrawing.GetVariable("ACADVER"), 2)) = 15 Then
Set dbxDoc = GetInterfaceObject("ObjectDBX.AxDbDocument")
Else
Set dbxDoc = GetInterfaceObject("ObjectDBX.AxDbDocument.16")
End If
dbxDoc.Open (strDwgName)

Dim Copyobjs As Variant
Dim idpairs As Variant
Dim arrObject() As AcadObject
Dim Ct As Integer, i As Integer
Dim oMod As AcadBlock
Set oMod = dbxDoc.ModelSpace
Ct = oMod.Count - 1
ReDim arrObject(Ct)
For i = 0 To Ct
Set arrObject(i) = oMod(i)
Next i
Copyobjs = dbxDoc.CopyObjects(arrObject, ThisDrawing.ModelSpace, idpairs)

Dim Ent As AcadEntity
Dim oGroup As AcadGroup, oGroups As AcadGroups
Dim NewGroup As AcadGroup
Dim GroupObj(0) As AcadObject
Set oGroups = dbxDoc.Groups

For Each oGroup In oGroups
If InStr(1, oGroup.Name, "*", vbTextCompare) <> 0 Then GoTo skipGroup
If oGroup.Count = 0 Then GoTo skipGroup

Set NewGroup = ThisDrawing.Groups.Add(oGroup.Name)
For Each Ent In oGroup
For i = 0 To UBound(idpairs)
If idpairs(i).key = Ent.ObjectID Then
Set GroupObj(0) = ThisDrawing.ObjectIdToObject(idpairs(i).value)
NewGroup.AppendItems GroupObj
End If
Next i
Next Ent
skipGroup:
Next oGroup

Set dbxDoc = Nothing

If Not IsMissing(Pt) Then
Dim Origin(2) As Double
For i = 0 To UBound(Copyobjs)
Set Ent = Copyobjs(i)
Ent.Move Origin, Pt
Next i
End If



End Sub

[Anonymous]

Ok.
You have resolve my problem.
Many thank's
GPaolo

ha scritto nel messaggio news:5022963@discussion.autodesk.com...
I thought Jeff Mishler would answer this, any way below is adapted from his
copy function. Since you explode the block I thought you might rather just
copy the objects instead. If you add a group to a block then explode the
blockref (in cad) it kills the group, but like you said if you insert the
block from another drawing and explode it, it stays as a group. Another
mystery. I don't know enough about lisp and reactors to figure that out but
in VBA there seems to be no info available to tell if an entity is part of a
group.
Sub GetBlockItems(strDwgName As String, Optional Pt As Variant)
'Requires a reference to Autocad/ObjectDbx Common library
Dim dbxDoc As AxDbDocument
If Int(Left(ThisDrawing.GetVariable("ACADVER"), 2)) = 15 Then
Set dbxDoc = GetInterfaceObject("ObjectDBX.AxDbDocument")
Else
Set dbxDoc = GetInterfaceObject("ObjectDBX.AxDbDocument.16")
End If
dbxDoc.Open (strDwgName)

Dim Copyobjs As Variant
Dim idpairs As Variant
Dim arrObject() As AcadObject
Dim Ct As Integer, i As Integer
Dim oMod As AcadBlock
Set oMod = dbxDoc.ModelSpace
Ct = oMod.Count - 1
ReDim arrObject(Ct)
For i = 0 To Ct
Set arrObject(i) = oMod(i)
Next i
Copyobjs = dbxDoc.CopyObjects(arrObject, ThisDrawing.ModelSpace,
idpairs)

Dim Ent As AcadEntity
Dim oGroup As AcadGroup, oGroups As AcadGroups
Dim NewGroup As AcadGroup
Dim GroupObj(0) As AcadObject
Set oGroups = dbxDoc.Groups

For Each oGroup In oGroups
If InStr(1, oGroup.Name, "*", vbTextCompare) <> 0 Then GoTo
skipGroup
If oGroup.Count = 0 Then GoTo skipGroup

Set NewGroup = ThisDrawing.Groups.Add(oGroup.Name)
For Each Ent In oGroup
For i = 0 To UBound(idpairs)
If idpairs(i).key = Ent.ObjectID Then
Set GroupObj(0) =
ThisDrawing.ObjectIdToObject(idpairs(i).value)
NewGroup.AppendItems GroupObj
End If
Next i
Next Ent
skipGroup:
Next oGroup

Set dbxDoc = Nothing

If Not IsMissing(Pt) Then
Dim Origin(2) As Double
For i = 0 To UBound(Copyobjs)
Set Ent = Copyobjs(i)
Ent.Move Origin, Pt
Next i
End If



End Sub