VBA, blocks and selectionset

[John the frog]

Hello all

First post on this forum !

[my life]
My name is John, I'm working in a shipyard in Brittany. I used to work on CoCreate ME10 system during many years but since a couple of years we changed our DAO system for AutoCAD 2004. I'm a kind of beginner with this...
With this changing I lost all my scripts I've written on ME10 system
Now I'm trying to do new VBA scripts to replace all the custom tools I had.

I'm doing this with VBA because I know this language pretty good : I use VBA with Excel or Access and I don't want to learn a new one as autolisp !
[/ my life]

My problem is :
We will received ACAD files containing nested steel plate parts, ready to be cut with a numeric plasma cutting machine. This files are done by an automatic output from a CAO system (FORAN).
But we want to get the parts on single DXF ou DWG files : one part is one DXF/DWG file (and not one file with many parts).
One part is defined by two layers : one layer describing the boundary of the plate and a second layer describing the marking on the plate.
The files we will received will contain many layers, two layers per plate part:

Example :
Part #01
-> layer "01" = boundary of the plate #01
_> layer "M_01" = marking on the plate #01
Part #02
-> layer "02" = boundary of the plate #02
_> layer "M_02" = marking on the plate #02
etc.

What I want to do is :
- select layer "01" (containing lines, polylines, arc)
- select layer "M_01" (containing lines, polylines, arc)
- create a block "Part_01"
- copy these entities in the block "Part_01"
- rename the layer "01" as layer "Boundary"
- rename the layer "M_01" as layer "Marking"
- save the block "Part_01" in a DXF format (or dwg format)
and then do the same things with layer "02"

an alternative way would to do like this :
- select layer "01" (containing lines, polylines, arc)
- select layer "M_01" (containing lines, polylines, arc)
- rename the layer "01" as layer "Boundary" in the selectionset
- rename the layer "M_01" as layer "Marking" in the selectionset
- save the selectionset as a dxf or dwg file.

but I don't know if it's possible to do this without a block creation.

I know how to select the layer I want and I've got an idea how to "browse" all the file to select all the layers "01"/"M_01", "02"/"M_02" etc. The choice of the layers is not a problem for me : it's a classic VBA problem.

But what I don't know is how I can copy the selected objets to put them in the block I created. And after how to save this block in a single dxf or dwg file.

Here is my code :

Sub SaveLayers()
Dim sset As AcadSelectionSet
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
Dim groupCode As Variant
Dim dataCode As Variant
Dim blockObj As AcadBlock
Dim insertionPnt(0 To 2) As Double

On Error GoTo gestErr

'Create the selectionset "JeuSel1"
Set sset = ThisDrawing.SelectionSets.Add("JeuSel")

'Sélection of marking layer and then boundary layer
gpCode(0) = 8 'layer
groupCode = gpCode
dataValue(0) = "M_01" 'layer name
dataCode = dataValue
sset.Select acSelectionSetAll, , , groupCode, dataCode

gpCode(0) = 8 'layer
groupCode = gpCode
dataValue(0) = "01" 'layer name
dataCode = dataValue
sset.Select acSelectionSetAll, , , groupCode, dataCode
sset.Highlight (True)

'Create block
insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "Part_01")

'Copy each object selected in the block
For Each acadObj In sset
'----->Here is my problem ! How to add the selected object in the block "Part_01" ?
Next acadObj

Exit Sub

gestErr:
If Err.Number = -2145320851 Then
    ThisDrawing.SelectionSets.Item("JeuSel").Delete
    Set sset = ThisDrawing.SelectionSets.Add("JeuSel")
    Resume Next
Else
    Debug.Print Err.Number
    Debug.Print Err.Description
    Exit Sub
End If
End Sub

Someone can help me ?

Thank you and sorry for my english ! I hope you will understand me !

John

[mahahaavaaha]

Hi,

this will write it out:

ThisDrawing.Wblock "Part_01.dwg", sset

/Petri

[John the frog]

Hello,

thank you for this reply but with this I store the block without changing the layer's names.
But I keep this reply because I will need it on the next step : store my finished block on hard disk.

John

[Bryco]

gpCode(0) = 8 'layer
groupCode = gpCode
dataValue(0) = "01,M_01" 'layer name
dataCode = dataValue
sset.Select acSelectionSetAll, , , groupCode, dataCode

sset.Highlight (True)

'Create block
insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "Part_01")

ReDim Obj(sset.count - 1) As AcadObject
Dim i As Integer
'Copy each object selected in the block
For i = 0 To sset.count - 1
Set Obj(i) = sset(i)
Next i

ThisDrawing.CopyObjects Obj, blockObj
Exit Sub

[John the frog]

OK ! Super ! Thank you

it seems to work perfectly ! I 'm going to adapt it in my script and I will post the entire finish code soon.

John