我用的是自己写的宏，一个在sw里用，可以单个文件改名。另一个宏是配合excel用，可以批量改名。
笑对人生123 发表于 2021-9-13 23:33
以前用这个宏超级快，可以节约很多时间
大神，能分享一下这个宏吗。。。感谢！~！
咋用宏命令改名后工程图还能链接上？
凯元可以
醉生梦 发表于 2021-9-13 15:18
这个是在“常跓宏”的基础上改的，有改名动作时，检测文件同文件夹下是否有同名的工种图文件，如果有，更改 ...
您好，请问能分享一下您这个宏吗？谢谢
醉生梦 发表于 2021-9-13 15:18
这个是在“常跓宏”的基础上改的，有改名动作时，检测文件同文件夹下是否有同名的工种图文件，如果有，更改 ...
能分享一下吗？
醉生梦 发表于 2021-9-13 15:18
这个是在“常跓宏”的基础上改的，有改名动作时，检测文件同文件夹下是否有同名的工种图文件，如果有，更改 ...
求分享！！！
data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAASQAAACpCAYAAACCoEBeAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAABQtSURBVHhe7Z1dbB7FesfHNo4Th8QOxPkgCQSdhDQFGhUpARHgptEpEqhtQEWHAzdVJW4KqEgcCRQd6Ui9IKhIVIBaFannplAkKkC9QKQlNwXxFQQVkBwShQOGfJ0QB5uQmMSxk/Kb7OOMx/u+fr3v17z2/yeNdnd2dnd23n3++zyzu/O2nTp16rwTQogEaM+mQgjRdCRIQohkkCAJIZJBgiSESAYJkhAiGSRIQohkkCAJIZKh6e8hDQ8PuxMnTrixsbEsp/l0dHS4hQsXuu7u7ixHCNEImu4hpSZGQH2olxCisTRdkFITIyPVegkxk1EfkhAiGSRIQohkkCAJIZKh6U/ZDh06lM1NZu3ate7kyZPuyJEjWc5Fyq2Dvr4+19vbmy05NzAw4AYHB92qVavc3Llzs9yL5O1rxYoV2ZwQohEkKUirV692nZ2d7vTp0250dHSCUJRbF0K5/v5+P2/itH//fr8cMn/+fHfFFVfkrpMgCdFYkgzZEJI8gYBy60JMjODYsWN+ivjEIFZDQ0PZkhCimcyYPqRFixb5MC5PdFgHP3mDfmqQz0uQJlhCiOYy4zu1EajFixfnekE9PT16AVKIhJgxgkSHNaFc6AUtX77c9w8dPnx4khck70iI9JixHhJP07q6uiaJlHHppZf67+iEEOkwI/uQSDzaDzu2Y+bMmeOf1Akh0mFGekiIDSBQYeKJGiBY7e3tPswTQqRD0i9GNhu9hyREY5nxT9mEEK2DBEkIkQxNFyQevadIqvUSYibTdEFiqNjUjJ/6UC8hRGPRf/sLIZJBfUhCiGSQIAkhkkGCJIRIBgmSECIZJEhCiGSQIAkhkkGCJIRIBgmSECIZJEhCiGSQIAkhkkGCJIRIBn3L9hNtbW1+lEl94S9EbTl//rwbGxtzIyMjWU55Zr2HhBjNmzdPYiREHcC+Lrnkkty/r89j1guSjb8thKgfjGGPME3FrBckeUZCNIZKbE2d2kKIhkD4NhUSJCFEMkiQhBDJIEESQiSDBEkIkQwSJCFEMkiQhBDJIEESQjQEXo6cCgmSEKJhdHZ2ZnP5SJAKwktehw4d8vObN292u3bt8vNGXt7jjz/ut8tLlL///vsn5dsxYshn/XPPPZfllCevPlDuGDHUn1QEjk0dSlGubeJEO8VUe37NaM/ZCIJU7o1tCVIBuOD4innlypXjFx8XpxkM6d1333U33njj+DIX8BNPPOG3++CDD9xjjz3mnn32WZ/Ie+edd9wLL7zg5y2VY8WKFe7gwYPuoYcecq+99lqWm48ZzqZNm/y0lDFVS9wGJDNw6vjoo4/6+TysbcJkbRTn004htTi/FNtzptLV1VVSlCRIBeDiBYwDUUJ8uDhDo7n55pu98NgyglMULvjY0EkcG+66665J69jGeOaZZ8bFIDamUuQdc/v27T7F+XasuA0QFIPt8uqJt2PeSZzYBoHIWxcKwHTPrxntKSZSSpQkSAXhLsqFyl0V8akEMzw8JzM2M7hyoRBihoHbsUKjDxPrKMO8CSAG8+KLL46LKPVGQM3QAEO05dA7CAWVhMCQwjzKTAVeUrwdMA29nXA9qZSHFLZ3kfNrVHtWw+nTp90PP/xQdTpx4sT4OaRGnihJkAqAgXFh8iPbhQlhH1AcssWGbsZmCeJ+lBg7lt2VQywvrA888sgj2dyFMgihXaB2kYbLW7du9Xm1BNF96623sqUL9QhFxQjPnzbG62Bbylt+LNzVnF+927Mazp49m81VB202ODjo9u3bV3Wd6kE8/I8EqQAPPvig7/MwuHtiPF999ZV79dVXxy/OMIWGwIUcX+hG6BHkQahAyBAThhEGRn311VePGz+iyP5LHbsWmHCQzAs0wQ3722677TY/D9SH8w37kShL6ER7IuyWTxlr71qcX+rtWSuOHTvmPv/8c9+GKSNBKkCpJ0J4RXn9D6SwDwIjRaC4kJkn5cHFE1/sbIfwhR6Xzcfezfvvvz8hJMKYEdN6Yx6CeYEcEwGyelKvcn0utJdBOTxK8mJPphbn1wrtWSuOHz+enCjFQ9vO+jG1u7u7s7nqQKQOHDjgVq1a5S9UAyG69957/YXLXZ/+hfiC4M5r3gMCNNVFbvux/hvzIEpBHZ5++ml/16f/oxzc/fFA2AaBrQTbBhAOBCkWUsSEelLnUvU1IbJ1dp62P0Ji6h9vW+T8QurVnuX2MRX0/9SK/v5+NzQ0lC05d/nll7v169dPEP5mcObMGT/edog8pBrAD4vBcPfkjs6ypZdffnnSnTZcTyrlIWHEXPwxHAsjxXCmMp4Q6kfZMIF5NKTQWDHQsCweT9w5bUacB/VHbIF2YVvqSxgWYn1vti9rF0QCmLJsYmTrY6Z7fka92jNVUvCU8sQIJEhVgFiYYZjoMLUfGgPkYieF2MVryfpYYrhz02cRY3d068ugDuTVEgy3XFhlUCbPyBEZOoCtXagffUrwyiuv+Klhhs2+4rYhmVCZkFl+rWhEe6ZGM0WplBiBBKkAdkfH+7EflH4H8kygyA+9JbYxLM9SKQ8JoyAENPA2KI/xsH+EgCl3ZPMizCNpJtTl4Ycf9vVDjBFu8szj4pyoa9wnBJyztYslQiO2iz3NammV9qwXzRAlnh6WEiOQIBXA7ugYmxkVhkRe+OOat0RiG8PyLJmHRHnEyQyRefqTQk/MtgmhHpZvBp0X6tUbRPm+++7z9UCMzeB5WmV5QB8by4RHoVBDeC4k9keoFperhlZpz0aAKO3du3dSG9SLqV5nUKd2jTq1hagltezU/vrrr/27SOXo6+tz69atGxfqenDu3Dn/wmc5JEgSJJEgtRSk4eFh/x7SVF7QokWLfKhaLyRIFSBBEilSS0GqFASjp6cnW6o9lQiS+pCEEJ5KBlCrNxIkIUQySJCEEMkgQRJCJIMEqQbYuyp5L/qVwj7QtfdrWI6H1jDyXhbMS3nvytg7N5WkvO3tJVDOLS5vybartJ5hYpuYIu0pZgYSpCrBeOxRKS/6xQZHsrd97UVBEvAY1l6Y5LOKUh/Vhi/q8fmEvXwYJj5TCYf0MOzt47hs/E0ayT4BCUczuOmmm/w6e6kx/C6MlPctW7iezzFKDcmSx3TaU8w8JEhVwB0c44mN1JIZvgkNU/Ljb9fMwOxzhSLGh6DV6tMKe5OaulcDwpY3JEupt66n255i5iFBKghCYV+G2x09hDAGryIciqQUfCKSZ4RgnomBB8GnFGGoQ13wmuKyRbEwzQZYY97GCIpFkzbIAzFilEjENz6nu+++209DatWeYYhqIR/zobDbd4dhG3LOFjKzD8qHnqKFpamyv/9bt/1fdri/+/VL7pF/eNn99j/fcT+cLP/OT4pIkArAxcpgXRgPFzUhiRkA65jnw9vYYzFDx8gxdrvY2d6+i7MLH2PIExkzIhMIoC6IlO0vNLQi2Ld6YIISfpcXJwv1DKsb+dSFc+HcqBseTtwuRdszhvYlbLV6mSBxTPZvWL5NgfYL989vRNvbvsAEKzUGBk+6f/rtTtd32aXu7//2z9wv/3KT2/v7P7h//Y+Lwwa3ChKkAhAyWN8PQsKFjBGZt8AFTH6MGTpCA/SvsJxnaHgC4Qe5BoPAcSwMxrD9ks8+8449XcxYX3rpJS8wJgylEusNzsc8GeqC+NI2iFueh1O0PWMY+TEsZ6EdwoLgGHhu/AaxMIXiz/rwd2FANs4jRT7e/Y3rntfl/uavN7u1q5e4jX+y2v3Flg1u31dHW85LkiBViRkk/SRgIU6YQm/GLn7u2lzk3HVZH/arsMx2eWBYGB3GHd+xqUM8DnRRqANGyXhM7Nf6v0h0ZJuYWgr7daiXnTtYGbD8Ut6Gra+0PUMYmZPycXhlwkLb44HRr8XwKPbHA+Tze4TQmR9iQlet91kPfn7rH7t/fPxu195+8ZoZGRl1HW3trrOz9J8ypogEqQAWepGgVCcsybwhA2Oyi936RJ566qkJ/SoYENvFRovhIARshwBgUGaclI3v6kXB6Gw4XuqKtxJ6QFPBOdn5m6BQz1DUQk+pmvYMsf0D+wrbj+1oPxMf2hBh4lwJ50LvqNX5v98dcK/s+NjddtNaN7er/F9Xp4YEqQAWItnFXykYZRx6YOh4IbGQPPnkkz5EwIAMBirDCzDoo8GTwCOgbF6IVwTqFAskBmuiQSiFMdsyqZTnYO2E6FIuPB+jaHuWgnbBi6NNrF4IK8LD8U18TKTwOmNBis/H6l1J6NhM/vutPe6f//1/3ZbN690v7tyY5bYOEqQGwtCtYWjDRY8HQfgQY2GZ/Q+YGU64vRkJ4kDZWoF3FAskBmuikReyxYaK+JpY4akgEpSrpSdC+7F/895Cj8gExerF+dB+eJVWB0QXoUSY4vrHNwOEv5ZtXA9Gzo65//qfT9xf/XyD2/rnfzohhGsVJEg1IO/9IUthZ2rswWAE5YwU8bEnVXglhE4G+ybPhoW1PAvhqqEWnlYoYBC2SWjoeVTanjEc08ohIIR+Bm2NiOKNmvhQHjGP+4vAbga2P5bDm0GKDP94xi3smef+6GfLspzWQ4JUA4r2eRgYKBc9ApP3tjUeAAbBXd76W+yYJmbWf2L7wlsgmUGFibs/KW9d6GUY5olYygvZwo5klkNR4VghbE9+KSptTxN0EwraJywbez2Ieyi28fYx5tWVK5MSvQu73fZfbXU/u7Ivy2k9NECbBmirGQgXQoQBVwKihPjEwtFsEFf7L71mUWSAtnPnzru9X/7Brbmqz83pvCTLnR4LFizI5mqPBmgTDcU8jkqhbGpi1Mr0Hzzunv63ne7jPQeynNZDHpI8JJEgRTyksZ88kN37Drv1a5bJQxJCNJeO9na3Yf3KwmKUAhIkIUQySJCEEMkgQRJCJIMESQiRDBIkIUQySJCEEMkgQRJCJIMESYgE6exs/DhGzThmjN7U1pvaQjSESt7U7ti2bdtvsvlZSbV3heeff96NjIz40RVjSq0j/6OPPvKpr6/P9fT0ZGsmUqocX6y3t7e7JUuW+OX33nvPvfHGG2X3JUSz4dvF0dHRbCkfhWwFYdwhBIPxdWLKrUNMGJfngQce8NMdO3ZkayZSabndu3e7zz77zJe78sors1whWhMJUkEYewcRyKPUum+++cZPr7vuuvEpISOiElJpuaGhIT8u0T333JPlCNHaSJAayIkTJ9z8+fOzpQssXbp00pfdlZbjv8puv/1219vbm+UI0dpIkFoUPCP6jBSmiZmEBKlFoV/p1KlT7s0338xyhGh9JEgNZOHChV5EQo4ePTpp1MRKyzG+Nv/WylM2IWYCEqQGYuGVdU7blHw6snkyR0d1uXIx9CHxlC3u8BaiFZEgNZg777zT9/8gPkzDv9AOqbQcIkX4Rhl5SqLV0ZvaelNbiIagMbWFEC2FBEkIkQwSJCFEMkiQhBDJIEESQiSDBEkIkQwSJCFEMkiQhBDJIEESQiSDBEkIkQz6dKS7e8rX2YUQ1TNnzpwpbU2C9JMg8Y2NEKL+6Fs2IUTLIEESQiSDBEkIkQwSJCFEMkiQhBDJIEGqgrfffttPv/jiCz+utWH5IR9++KE7cuRItnShTLicR7zfEP677fXXX/dp586dWe7F/HDf5NnxqEcM+WxT6lhCNAo99i/42B8DX7NmjduzZ49bvXq1+/HHH/0A/cuXL3f79u3zZbq6utyWLVv8PAbPv4kgDnlQlv3YtqVgDO3rr7/e7+eTTz5xt956qxckti+1b8pQlvoePHjQbdy40dfHCOspRD3Re0hTUESQ8CQWL17s/112165d7syZM9maC39hhOEPDAz4MggUng6ChZCUIy5XbjkWpHKCYmVDQZpqGyHqgQRpCop6SIQ5eEexUZvnhOGvW7fOCxTGj/ezZMmS3HAObrjhBv9fbNPxkGxf5uFQp1BwNm3aNO6VhcdlH/ztUgx1QECFqBcSpCmoNmRDAL799lufhzAgAiwjDngveFMYP+JE+XJU4yFZ2Dhv3jwvahzPlhFCK2uwDfW1PPqWTECFqBd6U7sOIDIIAuCN3HHHHT7hpWDQg4ODfh3wA9gfPLINfTd5CQGbLra/EMLIPKxs6CnNnTt3/Dy+//57iZFoOvKQCnhI9qRq5cqVEzwk84IwekIf84gQMDyVSjyk6YRslLXwDA/JRA2vx4SHepiHtGHDhglT8/AQpkrqJ0S1TOUhdWzbtu032fyspLOz050/Pz1N5j/2Dx8+PN4/gxCxH9J3333njh8/7sOhpUuX+vIIFusuu+wy76Xs379/Ulq2bJnvQ8LDueWWW9w111zj2tvbJyyTEI5PP/3UTzk2dfnyyy9db2+vO3ny5HgIdtVVV/n1HBeGh4d9J/vRo0fdggUL/DL1ZluwsFCIejI6OprN5aOQrUpQfESDaX9/v/dSrr32Wr+cF4YhVBbiWbJQCQ8lFIa88Atxw6NBvBYtWpTlXgABshCQZB3XPPELy+KJ4d3Ze0eEa+QJ0WwUshXs1CZsQxgQHsImCMMoIJSiXykM2RCKPPBs8vpw8spTluMgMkzZzjyjEDuudbBTP0I5Ow5elQkg58O55O1HiFrBNVYOCVJBQRJCTJ+pBEkhmxAiGSRIQohkkCAJIZJBgiSEaAiVvF4z6wVpbGwsmxNC1JNKHh7NekEaGRnJ5oQQ9eTs2bPZXGlm/WN/aGtr8/8Z1dHRkeUIIWoBYRpRSKU3fgmSECIZ1KkthEgGCZIQIhkkSEKIZJAgCSGSQYIkhEgGCZIQIhkkSEKIZJAgCSGSQYIkhEgGCZIQIhkkSEKIZJAgCSGSoW1gYEAf1wohkkBf+wshkkEhmxAiGSRIQohkkCAJIZJBgiSESAYJkhAiGSRIQohkkCAJIZJBgiSESAYJkhAiGSRIQohkkCAJIZJBgiSESATn/h+uNoGD+oJ7EAAAAABJRU5ErkJggg==我想分享一下，但是上传不了怎么办.....
宏文件
Dim swApp As Object
Dim swAssy As SldWorks.AssemblyDoc
Dim swAssyEvents As Class1
Dim swprt As SldWorks.PartDoc
Dim swprtEvents As Class2
Sub main()
Set swApp = Application.SldWorks
Set prt = swApp.GetFirstDocument
If Not prt Is Nothing Then
Set prt = swApp.ActiveDoc
If prt.GetType = 2 Then
Set swAssy = prt
Set swAssyEvents = New Class1
Set swAssyEvents.swAssy = swApp.ActiveDoc
ElseIf prt.GetType = 1 Then
Set swprt = prt
Set swprtEvents = New Class2
Set swprtEvents.swprt = swApp.ActiveDoc
End If
End If
End Sub
//////////////////////////////////
Class1
//////////////////////////////////
Public WithEvents swAssy As SldWorks.AssemblyDoc
Public Function swAssy_RenameItemNotify(ByVal entType As Long, ByVal oldName As String, ByVal NewName As String) As Long
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
If InStrRev(oldName, "\") <> 0 Then
Path = Left(oldName, InStrRev(oldName, "\"))
nfi = Left(NewName, InStrRev(NewName, ".") - 1)
tmpfi = Dir(Path & "*.SLDDRW")
Do Until tmpfi = ""
vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
If Mid(vDepend(1), InStrRev(vDepend(1), "\") + 1) = Right(oldName, Len(oldName) - InStrRev(oldName, "\")) Then
Name Path & tmpfi As nfi & ".SLDDRW"
bl = swApp.ReplaceReferencedDocument(nfi & ".SLDDRW", vDepend(1), NewName)
Exit Do
End If
tmpfi = Dir
Loop
Part.Save
Else
Set swSelMgr = Part.SelectionManager
Set swComp = swSelMgr.GetSelectedObject(1)
mip = swComp.GetPathName
oldn = Left(oldName, InStrRev(oldName, "-") - 1)
Path = Left(mip, InStrRev(mip, "\"))
ntype = Mid(mip, InStrRev(mip, "."))
If mip <> "" Then
tmpfi = Dir(Path & "*.SLDDRW")
Do Until tmpfi = ""
vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
If Mid(vDepend(1), InStrRev(vDepend(1), "\") + 1) = (oldn & ntype) Then
Name Path & tmpfi As Left(mip, InStrRev(mip, ".") - 1) & ".SLDDRW"
bln = swApp.ReplaceReferencedDocument(Left(mip, InStrRev(mip, ".") - 1) & ".SLDDRW", vDepend(1), mip)
Exit Do
End If
tmpfi = Dir
Loop
End If
End If
Set Part = Nothing
End Function
//////////////////////////////////
Class2
//////////////////////////////////
Public WithEvents swprt As SldWorks.PartDoc
Public Function swprt_RenameItemNotify(ByVal entType As Long, ByVal oldName As String, ByVal NewName As String) As Long
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Path = Left(oldName, InStrRev(oldName, "\"))
nfi = Left(NewName, InStrRev(NewName, ".") - 1)
tmpfi = Dir(Path & "*.SLDDRW")
Do Until tmpfi = ""
vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
If Mid(vDepend(1), InStrRev(vDepend(1), "\") + 1) = Right(oldName, Len(oldName) - InStrRev(oldName, "\")) Then
Name Path & tmpfi As nfi & ".SLDDRW"
bl = swApp.ReplaceReferencedDocument(nfi & ".SLDDRW", vDepend(1), NewName)
Exit Do
End If
tmpfi = Dir
Loop
Part.Save
End Function