Adicionar uma alternativa para substituição do template das propriedades personalizadas por meio das macros. Possuo revisão no formato do template e não encontro de maneira nativa como fazer a alteração.
Look into the CustomPropertyBuilderTemplate method.
Dê uma olhada no método CustomPropertyBuilderTemplate.
Muito Obrigado, consegui fazer a alteração aplicando conforme abaixo
Sub Main()
DefinirTemplatePropriedade
AlternarTaskPane
End Sub
Function DefinirTemplatePropriedade()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModDocExt As SldWorks.ModelDocExtension
Dim templatePathPeça As String
Dim templatePathMontagem As String
Dim currentTemplate As String
’ Caminhos dos templates
templatePathPeça = “Y:\01 PRJ - PROJETO\Projetos\Solid Defaults\Propriedades\02 - Propriedade de Peça POTENZA.prtprp”
templatePathMontagem = “Y:\01 PRJ - PROJETO\Projetos\Solid Defaults\Propriedades\02 - Propriedade de Montagem POTENZA.asmprp”
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox “Nenhuma peça ou montagem ativa encontrada.”, vbExclamation, “Erro”
Exit Function
End If
Set swModDocExt = swModel.Extension
’ Verifica o tipo de documento ativo (Peça ou Montagem)
If swModel.GetType = swDocPART Then
templatePath = templatePathPeça
ElseIf swModel.GetType = swDocASSEMBLY Then
templatePath = templatePathMontagem
Else
MsgBox “Documento ativo não é uma peça nem uma montagem.”, vbExclamation, “Erro”
Exit Function
End If
’ Testa se conseguimos ler o valor atual do CustomPropertyBuilderTemplate
'On Error Resume Next
'currentTemplate = swModDocExt.CustomPropertyBuilderTemplate(False)
'If Err.Number <> 0 Then
’ MsgBox "Erro ao ler CustomPropertyBuilderTemplate: " & Err.Description, vbCritical, “Erro”
’ Err.Clear
’ Exit Function
'End If
'On Error GoTo 0
’ Exibe o valor atual
'MsgBox "Template atual: " & currentTemplate, vbInformation, “Informação”
’ Tenta definir o template
On Error Resume Next
swModDocExt.CustomPropertyBuilderTemplate(False) = templatePath
MsgBox “Template Alterado. ALTERNE ENTRE GUIA DE PROPRIEDADES IMEDIATAMENTE PARA APLICAR A ALTERAÇÃO!”, vbInformation, “Sucesso”
On Error GoTo 0
End Function
Function AlternarTaskPane() As Boolean
Dim swApp As SldWorks.SldWorks
Set swApp = Application.SldWorks
’ Tenta ocultar o painel de tarefas
swApp.SetToolbarVisibility swToolbar_e.swTaskPaneToolbar, False
’ Tenta mostrar o painel de tarefas
swApp.SetToolbarVisibility swToolbar_e.swTaskPaneToolbar, True
End Function