AnsweredAssumed Answered

Macro Rename Draw and change name on feature manager

Question asked by Yerko Gatica Lagos on Aug 19, 2020

Hi everyone, I made some macro for Rename Draw and change the name on feature manager. The maro run very well but a can't change by the same name the part or assemble on feature manager tree.

 

******************************************************************************
' Macro 08/19/20 by ygatica
' ******************************************************************************

 

Dim Part As Object
Dim longstatus As Long, longwarnings As Long
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportData As SldWorks.ExportPdfData
Dim boolstatus As Boolean
Dim filename As String
Dim lErrors As Long
Dim lWarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")

If swModel Is Nothing Then
MsgBox "Sin documento actual", vbCritical
End
End If
If swModel.GetType <> swDocDRAWING Then
MsgBox "Esta Macro solo trabaja en Drawings", vbCritical
End
End If
'
filename = swModel.GetPathName
filenameOld = filename
If filename = "" Then
MsgBox "Por favor guarde el archivo primero y intentelo nuevamente", vbCritical
End
End If
'save as
filename = swModel.GetPathName
filenameOld = filename
FilePath = Left(filename, InStrRev(filename, "\"))
sFileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
sFileName = Left(sFileName, InStrRev(sFileName, ".") - 1)

'carga formulario on informacion
UserForm1.TextBox1.Value = sFileName
UserForm1.Show
'cambia ventana
Call changview
Call changstatus
'cierra el documento activo
'swApp.CloseDoc filename
End Sub

Sub changview()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Dim COSMOSWORKSObj As Object
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "BE-794 0000.SLDASM", False, longstatus
Set Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
'StudyManagerObj = Nothing
'ActiveDocObj = Nothing
Set CWAddinCallBackObj = Nothing
Set COSMOSWORKSObj = Nothing
End Sub

Sub changstatus()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("Anotacion", "DCABINET", 0, 0, 0, False, 0, Nothing, 0)
Set Feature = Part.SelectionManager.GetSelectedObject6(1, 0)

'Debug.Print Feature.Name
'Feature.Name = "Annotations"
'Debug.Print Feature.Name

End Sub

 

And also ave a form whit this code.

 

Sub CommandButton1_Click()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")

 

'save as
filename = swModel.GetPathName
filenameOld = filename
FilePath = Left(filename, InStrRev(filename, "\"))
sFileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
sFileName = Left(sFileName, InStrRev(sFileName, ".") - 1)

newname = TextBox1.Text
filename = FilePath & newname & ".SLDDRW"
longstatus = swModel.SaveAs3(filename, 0, 0)


'borra oldfile
'Kill filenameOld

Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists(filenameOld) Then oFSO.DeleteFile filenameOld


'cierra el formulario
Unload UserForm1

'cierra el documento activo
'swApp.CloseDoc filename

End Sub

Private Sub CommandButton2_Click()
End
End Sub

Attachments

Outcomes