Insert blocks from an excel listing...

[mcqit]

Hi, I hope someone can help, I'm not a lisp expert, but do a little VBA, so I'd like help with that if possible... I work as a land surveyor, I am using Autocad 2006 3D Map. I have a lot of occasions where I have lists of coordinates that need to be inserted as blocks in Autocad. The form of the list is point name, XYZ, the blocks are already defined, the point name goes in as an attribute of the block.
I'd like a vba routine where I select the points in excel, select my block from a directory where I store my blocks using the insert block routine already in autocad, scale etc, then ask autocad to insert these positions.... nothing to it hey... i'd be greatful for any help.

[fixo]

Correct me if I am wrong
I guess your Excel file perhaps looks like this:

PointName1
X1 Y1 Z1
PointName2
X2 Y2 Z2
etc.

Fatty

~'J'~

[mcqit]

It is 4 columns... Pointname,x,y,z.

Thanks

[fixo]

Put this code into desired sheet where stored your data
You need select all the four cells in the certain row and then
immediately click right mouse button
Change all to your suit: block name and tags
Works slowly, be patience
HTH

Option Explicit

Dim pnum As String, x As String, y As String, z As String
Dim acApp As AcadApplication
Dim acDoc As AcadDocument
Dim acSpace As AcadBlock
Dim acdCap As String, ExcCap As String
Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   If Target.Columns.Count = 4 And Target.Rows.Count = 1 Then

   Dim rng As Range, lCell As Range
   Dim rCnt As Long, cCnt As Long
   ActiveCell.EntireRow.Select
   Set rng = Application.Selection
   
   pnum = rng.Cells(1, 1)
   x = rng.Cells(1, 2)
   y = rng.Cells(1, 3)
   z = rng.Cells(1, 4)
   Call GoAcad
        Cancel = True
    Else
        MsgBox "Wrong cell double clicked"
        Cancel = True
    End If

End Sub
Private Sub GoAcad()
On Error GoTo Err_Control
ExcCap = Application.Caption
Dim bName As String, fn As String
bName = "POINT"
fn = GetFilePath
Set acApp = CreateObject("Autocad.Application")
acApp.Visible = True
acApp.WindowState = acMax
Set acDoc = acApp.Documents.Open(fn, False)
acDoc.Activate
Set acDoc = acApp.ActiveDocument
SetFocus acDoc.hwnd

If acDoc.GetVariable("CVPORT") = 1 Then
    Set acSpace = acDoc.PaperSpace
Else
    Set acSpace = acDoc.ModelSpace
End If
Dim oblkRef As AcadBlockReference
Dim ipt(2) As Double
ipt(0) = CDbl(x): ipt(0) = CDbl(y): ipt(0) = CDbl(z)
Set oblkRef = acSpace.InsertBlock(ipt, bName, 1, 1, 1, 0)
Dim attVar As Variant
Dim acnt As Integer
attVar = oblkRef.GetAttributes
For acnt = 0 To UBound(attVar)
Select Case UCase(attVar(acnt).TagString)
Case Is = "POINTNUMBER"
attVar(acnt).TextString = pnum
Case Is = "X"
attVar(acnt).TextString = x
Case Is = "Y"
attVar(acnt).TextString = y
Case Is = "Z"
attVar(acnt).TextString = z
End Select
Next

DoEvents

    acDoc.SaveAs (fn)
    acApp.Quit
    Set adoc = Nothing
    Set acApp = Nothing
AppActivate ExcCap, True
'AppActivate Application.ExcCap
SetFocus Application.hwnd '' back to Excel

Err_Control:
If Err.Number = 0 Then
MsgBox "Insertion was successful"
Else
MsgBox Err.Description
End If

End Sub
'' forget about where I stealed this function
Public Function GetFilePath() As String
    'Declare a variable as a FileDialog object.
    Dim fd As FileDialog
    'Declare a variable as a file name string.
    Dim fn As String
    
    'Create a FileDialog object as a File Picker dialog box.
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    'Declare a variable to contain the path
    'of each selected item. Even though the path is a String,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim vrtSelectedItem As Variant

    'Use a With...End With block to reference the FileDialog object.
    With fd
            
         'Allow the selection of single file.
        .AllowMultiSelect = False

        'Use the Show method to display the File Picker dialog box and return the user's action.
        'The user pressed the action button.
        If .Show = -1 Then

            'Step through each string in the FileDialogSelectedItems collection
            For Each vrtSelectedItem In .SelectedItems

                'vrtSelectedItem is a String that contains the path of each selected item.
                'You can use any file I/O functions that you want to work with this path.
                'This example simply displays the path in a message box.
                fn = vrtSelectedItem

            Next vrtSelectedItem
        'The user pressed Cancel.
        Else
        End If
    End With

    'Set the object variable to Nothing.
    Set fd = Nothing
    GetFilePath = fn
End Function

Fatty

~'J'~

[mcqit]

Wow, thanks for all that code I appreciate it.. I've inserted the code into a module in excel, but when I try to run it nothing happens.... I'm I doing something stupid....

[fixo]

Sorry for the late answer
I was not at home yesterday
Let you send me test message on my address:
fattyhallex@gmail.com
I'll send you sample Exctl and Acad files

~'J'~

[fixo]

Wow, thanks for all that code I appreciate it.. I've inserted the code into a module in excel, but when I try to run it nothing happens.... I'm I doing something stupid....

Here is sample Excel file with embedded code I sent earlier
Open code and change there what you need
HTH

Fatty

~'J'~

[fixo]

Try this one, I haven't understood exactly
what you need earlier, hope this will be work better for you
Change block name, tags and reference to your current
Acad version

Fatty

~'J'~

[iain9876]

hi fatty,

what if you had a fourth line to define different codes which would represent different blocks or linetypes like the following:

1, point number,
2, X
3, Y
4, Z
5, code

For example, if i was surveying a fence, and had the code F001, I would need to gather several points with the same code to represent the fence, I would then want to join all these points with the same codes together. and then carry on with other codes e.g F002, F003 etc.. (or KB001 or TR001 tree block for example) to represent a kerb...codes I guess would have to be user defineable from the start. The above would all have to have their respective layers also.

could you modify the above code to include that?

[fixo]

hi fatty,

what if you had a fourth line to define different codes which would represent different blocks or linetypes like the following:

1, point number,
2, X
3, Y
4, Z
5, code

For example, if i was surveying a fence, and had the code F001, I would need to gather several points with the same code to represent the fence, I would then want to join all these points with the same codes together. and then carry on with other codes e.g F002, F003 etc.. (or KB001 or TR001 tree block for example) to represent a kerb...codes I guess would have to be user defineable from the start. The above would all have to have their respective layers also.

could you modify the above code to include that?

I am not sure that I could be to do this, anyway I'll try
to wrote something similar, but I need more explanation about.
Let you send me sample drawing with your task,
see my address three threads above

>'J'<