Macro Intermittent

[Scorch]

I have created a macro that will take a model view and insert it on to our DXF drawing sheet and will do a save as and save it to the user specified location. On some computers the macro runs without any issues on some other computers the macro fails to create the DXF and save it to the location specified. Has anybody had this happen with their macros? If needed I can post the code so the experts can go through it.

Thanks



Don't worry about people stealing your ideas. If your ideas are any good, you'll have to ram them down people's throats.
--Howard Aiken, IBM engineer

 

[Standing]

Yes, post the code. However, always check the file location with code in the macro to see if the directory is on the hard drive. If not then create the directory.

Bradley

 

[Scorch]

The file is always saved in an already created directory across the network, so creating the directory is not needed. I have attempted to save the DXF on a local hd and on a network drive on some computers and it does not work.


Dim swApp As Object
Dim Part As Object
Dim retval As String
Dim modeldoc As Object
Dim strPartName As String
Dim strPathName As String
Dim strDrawName As String
Dim strSavePath As String
Dim View As Object
Dim bolMapping As Boolean
Dim intScale As Integer

Private Sub cmdBrowse_Click()

strSavePath = GetDirectory
strSavePath = strSavePath & "\"
txtPath = strSavePath

End Sub

Private Sub cmdCancel_Click()
End
End Sub

Private Sub cmdOk_Click()

'Update Save Path

strSavePath = txtPath
SaveSetting "CreateProfileDWG", "General", "SavePath", strSavePath

'Connect to Solidworks
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc
Set modeldoc = swApp.ActiveDoc


'Find File Name
strPartName = modeldoc.GetTitle()
strDrawName = Replace(strPartName, "SLDPRT", "dxf")


' Create Drawing
Set Part = swApp.NewDrawing2(swDwgTemplateCustom, "G:\~ENGINEERING\solidworks templates\DXF Template.drwdot", 6, 0.297, 0.21)
retval = Part.CreateDrawViewFromModelView(strPartName, "Current Model View", 0.1449224704336, 0.0999914586071, 0)
Part.SetupSheet4 "Sheet1", 6, 13, 1, 1, 1, "*.drt", 0.297, 0.21, "Default"
Part.SelectByID "Drawing View1", "DRAWINGVIEW", 0.2510516302174, 0.07917764706756, 0
Part.ViewZoomToSelection


'Set export options
bolMapping = swApp.GetUserPreferenceToggle(swDxfMapping)
swApp.SetUserPreferenceToggle swDxfMapping, False
intScale = swApp.GetUserPreferenceIntegerValue(swDxfOutputNoScale)
retval = swApp.SetUserPreferenceIntegerValue(swDxfOutputNoScale, 0)

'Save Drawing
strSavePath = strSavePath & strDrawName
Debug.Print "Full Path = " & strSavePath
retval = Part.saveas3(strSavePath, 0, 1)
currentdoc = Part.GetTitle
swApp.CloseDoc currentdoc

'Return export options to orgionals
swApp.SetUserPreferenceToggle swDxfMapping, bolMapping
retval = swApp.SetUserPreferenceIntegerValue(swDxfOutputNoScale, intScale)

frmMain.Hide

End Sub

Private Sub Label1_Click()

End Sub

Private Sub OptionButton1_Click()

End Sub

Private Sub txtPath_Change()

End Sub

Private Sub UserForm_Activate()

'Get save path from registry

strSavePath = GetSetting("CreateProfileDWG", "General", "SavePath")
Debug.Print strSavePath
txtPath = strSavePath

End Sub



Don't worry about people stealing your ideas. If your ideas are any good, you'll have to ram them down people's throats.
--Howard Aiken, IBM engineer

 

[CorBlimeyLimey]

If it's consistently the same computers on which it doesn't work, then it's probably not the macro. It is more likely to be a setting or program on the "rogue" computers which is blocking the macros actions.


Helpful SW websites FAQ559-520
How to get answers to your SW questions FAQ559-1091