论坛 › SOLIDWORKS › SOLIDWORKS 宏合并执行的问题

arter_2006 发表于 2018-11-23 12:41:43

SOLIDWORKS 宏合并执行的问题

是这样的，想做一个宏，通过这个宏，会先后调用其它的宏，请问如何编写？非常感谢。
宏的名称分别是：
删除所有配置属性.swp
删除自定义属性.swp
partitionTM.swp

ryouss 发表于 2018-11-23 14:34:19

參考


Sub 删除所有配置属性()
   .
   .
   .
   Call 删除自定义属性 '呼叫 "删除自定义属性" 之宏
   .
   .
End Sub


Sub 删除自定义属性()
   .
   .
End Sub

arter_2006 发表于 2018-11-24 12:51:08

ryouss 发表于 2018-11-23 14:34
參考




非常感谢您的指点，根据我的浅薄理解，我的宏如下，但不起作用：
' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx10500\Macro1.swb - macro recorded on 11/24/18 by arter
' ******************************************************************************
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub 删除所有配置属性()



    Call 删除自定义属性


End Sub

Sub 删除自定义属性()



   Call partitionTM


End Sub

Sub partitionTM()


End Sub

能否帮我改下？非常感谢。

arter_2006 发表于 2018-11-24 12:53:47

不知道3个宏有没有问题，这三个宏单独执行的是没问题的。上面提到的，就是想把附件压缩包里的三个宏联合执行。

ryouss 发表于 2018-11-24 13:45:49

arter_2006 发表于 2018-11-24 12:53
不知道3个宏有没有问题，这三个宏单独执行的是没问题的。上面提到的，就是想把附件压缩包里的三个宏联合执 ...


   


' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String

Sub main() '刉壺垀衄饜离扽俶(刪除所有配置屬性)
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
      For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
      Next
    End If
Next
Call 刉壺赻隅砱扽俶 '(刪除自定義屬性)
Call partitionTM

End Sub

'~~~ 刉壺赻隅砱扽俶 ~~~
Sub 刉壺赻隅砱扽俶() '(刪除自定義屬性)
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
If Not IsEmpty(vCustInfoNameArr2) Then
   For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
End If
End Sub

'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM

'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'扢隅曹講
c = swApp.ActiveDoc.GetTitle() '錨璃靡
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "第蹋")
blnretval = Part.DeleteCustomInfo2("", "測瘍")
blnretval = Part.DeleteCustomInfo2("", "靡備")
blnretval = Part.DeleteCustomInfo2("", "第蹋")
a = InStr(c, " ") - 1
If a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)
    If t = "GBT" Then
      e = "GB/T" + Mid(k, 4)
    Else
      e = k
    End If
    b = Mid(c, a + 2)
    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
      j = Len(b) - 7
    Else
      j = Len(b)
    End If
    m = Left(b, j)
End If
blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")

End Sub

arter_2006 发表于 2018-11-24 15:28:59

本帖最后由 arter_2006 于 2018-11-24 15:30 编辑

ryouss 发表于 2018-11-24 13:45

能否把您改后的swp文件上传上来？
非常感谢您的指点，上面的内容从网页上复制、黏贴到写字板或宏文件里后，都是乱码，执行不了，非常感谢您，让您费心了。

ryouss 发表于 2018-11-24 16:13:31

arter_2006 发表于 2018-11-24 15:28
能否把您改后的swp文件上传上来？
非常感谢您的指点，上面的内容从网页上复制、黏贴到写字板或宏文件里 ...

远祥 发表于 2018-11-24 17:41:46

在原来的基础上改会方便一些。

arter_2006 发表于 2018-11-25 09:12:54

以下是我改过的宏，不知道哪里出了问题？附件压缩包是写字板格式的。
' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String

Sub main() '刪除所有配置屬性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames)
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
      For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
      Next
    End If
Next
Call 刪除自定義屬性
Call partitionTM

End Sub

'~~~ 刪除自定義屬性 ~~~
Sub'刪除自定義屬性
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
If Not IsEmpty(vCustInfoNameArr2) Then
   For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
End If
End Sub

'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM

'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'扢隅曹講
c = swApp.ActiveDoc.GetTitle() '錨璃靡
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "第蹋")
blnretval = Part.DeleteCustomInfo2("", "測瘍")
blnretval = Part.DeleteCustomInfo2("", "靡備")
blnretval = Part.DeleteCustomInfo2("", "第蹋")
a = InStr(c, " ") - 1
If a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)
    If t = "GBT" Then
      e = "GB/T" + Mid(k, 4)
    Else
      e = k
    End If'
    b = Mid(c, a + 2)
    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
      j = Len(b) - 7
    Else
      j = Len(b)
    End If
    m = Left(b, j)
End If
blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")

End Sub

ryouss 发表于 2018-11-25 10:28:57

本帖最后由 ryouss 于 2018-11-25 10:59 编辑

arter_2006 发表于 2018-11-25 09:12
以下是我改过的宏，不知道哪里出了问题？附件压缩包是写字板格式的。
' ******************************** ...

查看完整版本: SOLIDWORKS 宏合并执行的问题