Mushtaq86
08-08-2018, 02:03 AM
I am having a template drawings in C Drive. And a Excel file with list of say 50 Names. The task is using Excel-VBA, I have to create 50 files (using that template file.
Summary of steps is as follows:
Open Excel files having list of file names
Run the script in excel VBA which opens AutoCAD template file from C drive and start saving with 50 names
Exit ACAD.Application
The Code I am using is mentioned below. Struck point is CAD Application is not saving the file with a new name or desired name and CAD application is not exiting with VBA
I am a rookie level in VBA in Excel and have zero knowledge of VBA in AutoCAD.
Your suggestions, help will be of great help..
Sub Run_CAD()
Dim ACAD AsObject
'Dim ACAD As AcadApplication
Dim NewFile AsObject
Dim MyAcadPath AsString
Dim bReadOnly AsBoolean
Dim st AsString
Dim MyPath AsString
Dim CurrentDwg AsObject
Dim foldername AsString
Dim Filename AsString
OnErrorResumeNext
Set ACAD = GetObject(,"AutoCAD.Application")
Set CurrentDwg = CurrentApp.ActiveDocument
If(Err <>0)Then
Err.Clear
Set ACAD = CreateObject("autocad.Application")
If(Err <>0)Then
MsgBox "Could Not Load AutoCAD!", vbExclamation
End
EndIf
EndIf
'If you want to see AutoCAD on screen
ACAD.Visible =True
MyPath ="C:\"
'Add a slash at the end if the user forget it
If Right(MyPath,1)<>"\"Then
MyPath = MyPath &"\"
EndIf
'Create folder for the new files
foldername = MyPath & Format(Now,"yyyy-mm-dd hh-mm-ss")&"\"
foldername ="C:\All CAD Files at "& Format(Now,"yyyy-mm-dd hh-mm-ss")&"\"
MkDir foldername
MyAcadPath ="c:\CAD Templates\DAE Template.dwg"
bReadOnly =True
Set NewFile = ACAD.Documents.Open(MyAcadPath, bReadOnly)
If saveit =TrueThen
'saveFolder = "F:\MHJ\"
Filename ="Hey"
filepath = MyPath & Filename
CurrentDwg.SaveAs filepath
Else
ACAD.Close False
EndIf
'If (NewFile Is Nothing) Then
'ErrorMessage:
'If NewFile = "False" Then End
'MsgBox "Could not find the required spreadsheet that should be located at" & vbCr & MyAcadPath & vbCr & "Please rename or relocate the specified file as needed."
'End
'End If
'****
MsgBox "Look in "& foldername &" for the files"
stFolder ="C:\"
If Len(Dir(stFolder, vbDirectory))<>0Then
Shell "Explorer.exe /n,/e,"& stFolder, vbNormalFocus
Else
MsgBox "The directory does not exist!", vbCritical
EndIf
'Close AutoCAD Process
CurrentDwg.Close False
ACAD.Close False
Set ACAD =Nothing
Set NewFile =Nothing
EndSub
Many Thanks in advance.
Summary of steps is as follows:
Open Excel files having list of file names
Run the script in excel VBA which opens AutoCAD template file from C drive and start saving with 50 names
Exit ACAD.Application
The Code I am using is mentioned below. Struck point is CAD Application is not saving the file with a new name or desired name and CAD application is not exiting with VBA
I am a rookie level in VBA in Excel and have zero knowledge of VBA in AutoCAD.
Your suggestions, help will be of great help..
Sub Run_CAD()
Dim ACAD AsObject
'Dim ACAD As AcadApplication
Dim NewFile AsObject
Dim MyAcadPath AsString
Dim bReadOnly AsBoolean
Dim st AsString
Dim MyPath AsString
Dim CurrentDwg AsObject
Dim foldername AsString
Dim Filename AsString
OnErrorResumeNext
Set ACAD = GetObject(,"AutoCAD.Application")
Set CurrentDwg = CurrentApp.ActiveDocument
If(Err <>0)Then
Err.Clear
Set ACAD = CreateObject("autocad.Application")
If(Err <>0)Then
MsgBox "Could Not Load AutoCAD!", vbExclamation
End
EndIf
EndIf
'If you want to see AutoCAD on screen
ACAD.Visible =True
MyPath ="C:\"
'Add a slash at the end if the user forget it
If Right(MyPath,1)<>"\"Then
MyPath = MyPath &"\"
EndIf
'Create folder for the new files
foldername = MyPath & Format(Now,"yyyy-mm-dd hh-mm-ss")&"\"
foldername ="C:\All CAD Files at "& Format(Now,"yyyy-mm-dd hh-mm-ss")&"\"
MkDir foldername
MyAcadPath ="c:\CAD Templates\DAE Template.dwg"
bReadOnly =True
Set NewFile = ACAD.Documents.Open(MyAcadPath, bReadOnly)
If saveit =TrueThen
'saveFolder = "F:\MHJ\"
Filename ="Hey"
filepath = MyPath & Filename
CurrentDwg.SaveAs filepath
Else
ACAD.Close False
EndIf
'If (NewFile Is Nothing) Then
'ErrorMessage:
'If NewFile = "False" Then End
'MsgBox "Could not find the required spreadsheet that should be located at" & vbCr & MyAcadPath & vbCr & "Please rename or relocate the specified file as needed."
'End
'End If
'****
MsgBox "Look in "& foldername &" for the files"
stFolder ="C:\"
If Len(Dir(stFolder, vbDirectory))<>0Then
Shell "Explorer.exe /n,/e,"& stFolder, vbNormalFocus
Else
MsgBox "The directory does not exist!", vbCritical
EndIf
'Close AutoCAD Process
CurrentDwg.Close False
ACAD.Close False
Set ACAD =Nothing
Set NewFile =Nothing
EndSub
Many Thanks in advance.