Swap Block via Excel, Autocad and VBA

[rpellicane]

hello, i'm looking for some help with VBA with respect to autocad. what i'm looking to do is Swap one block for another using excel to hold the listing of blocks in lieu of hard coding.

what i have/know:

an excel sheet with two cloumns and 135 rows (Row quantity might change)

there is a 1 to 1 relationship in the sheet per row

Column A Column B

oldblock newblock

i'm able to open the excel sheet with out a problem

what i dont know is:

how to "read" the drawing for block information

relate it to excel

replace/update the block

can anyone help?

[rkmcswain]

Do you mean that you want to update a block definition in a drawing?

 

Are you wanting to update this block definition:

• at run-time with various objects/properties?
  
• from a block definition stored in a separate drawing?
  
• from a complete .DWG file?
  

[rpellicane]

thanks for the reply..

 

the drawing will have a block in it.

the autocad user will pick a VBA button, which will read the blocks in the drawing, (i guess) hold this information. read the excel sheet. and replace the block with a new block...

 

does that answer your question?

[rkmcswain]

thanks for the reply..

 

the drawing will have a block in it.

the autocad user will pick a VBA button, which will read the blocks in the drawing, (i guess) hold this information. read the excel sheet. and replace the block with a new block...

 

does that answer your question?

 

Sort of, but when you say "replace the block with a new block" - where is this new block definition stored? In the same drawing? So a drawing contains blocks named "A" and "B", and you want to replace every insertion of "A" with "B"?

 

Or do you want to update the block definition of "A" with the block definition of "B"?

[rpellicane]

thanks for the reply.

the new block will be located on the server, not in the drawing.

with a different name.

so i guess the answer is update the block definition.

[Patrick_35]

Hi,

Try this french lisp

 

@+

Rbloc.zip

[kpblc]

And what about

_blockreplace

command ?

[rpellicane]

Thanks for all your help...

to Patrick_35, thanks but Lisp is not going to cut it.

attached below it the code i have so far....

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

Public Sub AccessExcel()

On Error Resume Next

' Check to see if Excel is already running and get the current application.

Set AppExcel = GetObject(, "Excel.Application")

' Excel is not running; need to start it.

If AppExcel Is Nothing Then

' Clear the above error.

Err.Clear

' Start Excel.

Set AppExcel = CreateObject("Excel.Application")

' Could not start Excel.

If Err.Number 0 Then

MsgBox "Could not start Excel. Ensure the program is installed.", _

vbCritical, "Excel Error"

Exit Sub

End If

End If

 

On Error Resume Next

Set AppExcel = CreateObject("Excel.Application")

If Err.Number 0 Then

MsgBox "Could not start Excel. Ensure the program is installed.", vbCritical, "Excel Error"

Exit Sub

End If

' Make the Excel window visible.used for testing

AppExcel.Visible = True 'used for testing when program is complete use

' AppExcel.Visible = False 'used when program is complete

End Sub

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

Public Sub Read_Blocks()

 

Call AccessExcel '

 

If AppExcel Is Nothing Then 'if excel wasn't found then exit the code

Exit Sub

End If

 

'define the excel objects

Dim WkBk As Workbook

Set WkBk = AppExcel.Workbooks.Open("K:\Acad-Blocks\Swap.xls")

Dim WkSt As Worksheet

Set WkSt = WkBk.Worksheets("Sheet1")

 

'define variables and default values

Dim intRow As Integer '

intRow = 1 '

 

Dim oldblock As String '

oldblock = WkSt.Cells(intRow, 1).Value '

Dim newblock As String '

 

 

Do Until oldblock = "" '

newblock = WkSt.Cells(intRow, 2).Value '

 

Call BuildSSetoBlocks(oldblock, newblock) '

 

intRow = intRow + 1 'increment the counter

oldblock = WkSt.Cells(intRow, 1).Value 'get the next value

Loop

 

Call CloseExcel

End Sub

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

Public Sub BuildSSetoBlocks(oldBlockName As String, newBlockName As String)

Dim objSSet As AcadSelectionSet

Dim strBlocks As String

Dim objBlockRef As AcadBlock

Dim intDxfCode(0 To 1) As Integer

Dim varDxfValue(0 To 1) As Variant

' Initialize string.

strBlocks = ""

' Step through all of the blocks in the drawing.

For Each objBlockRef In ThisDrawing.Blocks

strBlocks = strBlocks & objBlockRef.Name & vbCrLf

' Next

' ' Display the blocks to the user.

' MsgBox "Blocks defined in drawing: " & vbCrLf & vbCrLf & strBlocks

Next

'Block replace here old block for new block

 

 

 

End Sub

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

[mpozauko]

hey.

i know it's and old thread but i wonder if you ever get this routine to work ?