Jump to content

need help on Macro in excel


sumitkr1108

Recommended Posts

Hi All

 

I have this excel macro file which open autocad and close also but i want that it should input command to autocad after opening it with this macro. and that should be taken from column D. Through this we can solve may purposes. Is it possible?? can somebody help me with this??

Sub command()

Dim dwgname As String
Dim dwgpath As String
Dim fileRange As Range
Dim elem As AcadObject
Dim attelem As AcadAttributeReference
Dim Array1 As Variant
Dim Count As Integer
Dim colMax As Long
Dim exlTag As String
Dim exlValue As String
Dim exlHandle As String
Dim i As Long
Dim activeRow As Long
Dim handle As String
Dim attDict As AcadDictionary

If MsgBox("Do you want to proceed ?", vbYesNo) = 7 Then
    Exit Sub
End If

ThisWorkbook.Worksheets("Text").Activate ' activate sheet
Range("A1").Activate ' activate first cell
With ActiveSheet
 colMax = ActiveSheet.Cells(1, .Columns.Count).End(xlToLeft).Column
End With

'1) get Acad application object
Dim Acad_app As AcadApplication
Dim Acad_Doc As AcadDocument
Dim Acad_ModelSpace As AcadModelSpace
Dim Acad_PaperSpace As AcadPaperSpace

On Error Resume Next
Set Acad_app = GetObject(, "AutoCAD.Application")
If Err Then
    Err.Clear
    Set Acad_app = CreateObject("AutoCAD.Application")
    If Err Then
        MsgBox Err.Description
        Exit Sub
    End If
End If

Acad_app.Visible = True 'brings up window state
Acad_app.WindowState = acMax 'maximizes AutoCAD application
AppActivate Acad_app.Caption 'brings AutoCAD application in front
'1) ends here______________________________________

Set fileRange = ActiveSheet.Range("B2")

Do While Not (IsEmpty(fileRange))
    '2) open dwg file
    dwgname = fileRange.Value
    dwgpath = fileRange.Offset(0, 1)
    
    If Right(dwgpath, 1) <> "\" Then
     dwgpath = dwgpath & "\"  ' append \ if missing in last of path
    End If
    
    ' check if dwg file is already opened
    If Acad_app.Documents.Item(dwgname) Is Nothing Then
        ' open dwg file if not already opened
        Set Acad_Doc = Acad_app.Documents.Open(dwgpath & dwgname, 0)
    Else
        ' activate dwg file if already opened
        Set Acad_Doc = Acad_app.Documents.Item(dwgname)
        Acad_Doc.Activate
    End If
    '2) ends here______________________________________
    
    activeRow = fileRange.Row 'find current row number
        
    ' set block object from handle number in cell comment
    Set elem = Acad_Doc.HandleToObject(Cells(activeRow, 4))
    elem.TextString = fileRange.Offset(0, 2).Value
    
    Set fileRange = fileRange.Offset(1, 0)
    If Acad_Doc.Name = fileRange.Name Then 'if next row also contains same file name
        Acad_Doc.Save 'save only
    Else
        Acad_Doc.Close True 'save and close
    End If
    
Loop

 Acad_app.WindowState = acMin 'minimizes AutoCAD application
 MsgBox "Updated !"
  
End Sub

 

 

 

Edited by CADTutor
Moved code to code block
Link to comment
Share on other sites

4 hours ago, BIGAL said:

Thanks sir but i think you had posted the same content which i think is for my previous post.  I want the above macro to be modified in such manner that it take command from the D column for the clarity i am attaching the file 

TEST.xls

Link to comment
Share on other sites

I posted how you would make circles using excel reading values form other columns.

 

Just select the column D values copy then paste to Autocad command line LT ok also. No code needed.

 

If you insist on pasting a string look into sending Autocad strings to command line using VBA. 

 

This is VL will be similar (vla-sendcommand acdoc "Circle 0,0 1.0")

Link to comment
Share on other sites

8 hours ago, BIGAL said:

I posted how you would make circles using excel reading values form other columns.

 

Just select the column D values copy then paste to Autocad command line LT ok also. No code needed.

 

If you insist on pasting a string look into sending Autocad strings to command line using VBA. 

 

This is VL will be similar (vla-sendcommand acdoc "Circle 0,0 1.0")

sir thank for your effort but i dont know vba coding i am new to all these thing. can you creat excel having this vba creating button so that will take command from column D and execute it in autocad but it should take the path from column C and file name from column B. If you can please create that i will be thankful to you

Link to comment
Share on other sites

As you want multi dwgs you need to use a script, this is easy in excel just use =contcatenate("open ",b2,c2," circle 0,0,0 ","close Y") not tested copy the column to notepad and save as a script, then run using Script.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...