【改编】色卡颜色宏

tg000057

原贴是A神的：【改良】RAL及国标色卡颜色宏
1.修改了界面，
2.增加了pantong色号，
3.删除了对装配体的上色，所有的涂色都是对零件文档的。
4.A神原版的删除色，不知道为什么对本人的建模特征色不生效，只能打开零件才生效，故修改为打开上色。
5.此宏本意为出效果图给客户看，应用为装配体或零件中对一个或多个零件，或其一个或多个面上色，没应用其特征或实体上色。
6.此宏修改后没有多版本测试，版权仍为原贴作者所有，此仅供交流使用，请谨慎下载。
7.其余说明请看图片！

tg000057

xx123458xx 发表于 2023-4-28 09:56
分享一个给你。2390色，潘通C卡1~7号段。

感谢大佬的资料，共有2390色号值弄上去。
投桃抱李，
我把新更改的宏传上来，
直接用字典储存色号与其值，比现在用case的简便多了。
而且增加了其他功能，自行发现....


补充的内容 (2023-5-5 17:10):
为了不必要麻烦，新功能说明直接在后面上传个视频吧，不太清楚功能的，就多用一个金币下载视频看看。

duanli96

用不了用不了用不了用不了用不了

tg000057

更新了一下版本，新版代码就不上传，只上传个视频，给大家一个参考。
注意只有视频，谨慎下栽！

tg000057

   经典案例图书

duanli96 发表于 2023-4-17 13:32
用不了用不了用不了用不了用不了

看扫盲贴！

1194753477

感谢楼主分享，很不错！

duanli96

   经典案例图书

tg000057 发表于 2023-4-17 14:35
看扫盲贴！

运行后这是这样，扫什么盲？

tg000057

duanli96 发表于 2023-4-17 14:53
运行后这是这样，扫什么盲？

然后再看下我上面说明，没有多版本测试，仅供交流！

xx123458xx

这个潘通色卡值是907色的那个，色值不是很准，截图右侧是修正过的颜色色值，潘通C卡1~7号一共有2390色。

念心nx

感谢楼主分享，很不错！

tg000057

xx123458xx 发表于 2023-4-27 10:13
这个潘通色卡值是907色的那个，色值不是很准，截图右侧是修正过的颜色色值，潘通C卡1~7号一共有2390色。

...

907色是网上找的下载的，没有具体的核对过色值，修改过的色值色号你有资料吗，能不能分享一下？

xx123458xx

tg000057 发表于 2023-4-28 09:08
907色是网上找的下载的，没有具体的核对过色值，修改过的色值色号你有资料吗，能不能分享一下？

分享一个给你。2390色，潘通C卡1~7号段。

CASE.txt (384.51 KB, 下载次数: 34, 售价: 5 金币)

2023-4-28 09:55 上传

点击文件名下载附件
售价: 5 金币  [记录]
下载积分: 金币 -1

DIC.txt (48.93 KB, 下载次数: 154, 售价: 5 金币)

2023-4-28 09:55 上传

点击文件名下载附件
售价: 5 金币  [记录]
下载积分: 金币 -1

念心nx

感谢楼主分享，很不错！

331459561

楼主太厉害了

念心nx

加入QQ群
参与讨论和学习

或扫描二维码加入

新传的好像用不了0.0

风一样的男子

   经典案例图书

感谢楼主分享，很不错！

igxoqve

加入QQ群
参与讨论和学习

或扫描二维码加入

楼主有点不太地道,即然收费了就应该给完整的代码,来下载的就是想直接下下来使用,要么就是看看有没有好的方法思路,懂代码的修改后才可以用

igxoqve

   经典案例图书

楼主有点不太地道,即然收费了就应该给完整的代码,来下载的就是想直接下下来使用,要么就是看看有没有好的方法思路,懂代码的修改后才可以用,我不能上传图片,也不能上传附件,所以只能打字说说:第一把设置颜色模块里的
'If Dir("C:\ma_t_f", vbDirectory) = "" Then MkDir "C:\ma_t_f"
'Dim Ma_p_n_ As String
'Ma_p_n_ = Application.SldWorks.GetCurrentMacroPathName
'Ma_p_n_ = Left(Ma_p_n_, InStrRev(Ma_p_n_, "\") - 1)
'Ma_p_n_ = Left(Ma_p_n_, InStrRev(Ma_p_n_, "\") - 1)
'Application.SldWorks.RunMacro Ma_p_n_ & "\宏启动器.swp", "ms_ms", "msms"
'If Dir("C:\ma_t_f", vbDirectory) <> "" Then Exit Sub
这些删除
第二在usfSetColor用户窗体里代码增加'选择零件
Private Sub CommandButton2_Click()
   
    Dim swPart              As SldWorks.ModelDoc2
    Dim swSelectionMgr      As SldWorks.SelectionMgr
    Dim count               As Integer
    Dim i                   As Integer
    Dim swModel2()          As Variant
   
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    PathName = swModel.GetPathName
   
    If swModel.GetType = 1 Then
        Set_Bo = 3
        Label5.Caption = "已选择当前<零件>对象！"
        swModel.ClearSelection2 True                 '取消选择
        set_color
    ElseIf swModel.GetType = 2 Then
        Set swSelectionMgr = swModel.SelectionManager
        count = swSelectionMgr.GetSelectedObjectCount2(-1)
        If count = False Then MsgBox "请选择对象!": Exit Sub
        Set Path_Arr = CreateObject("Scripting.Dictionary")   '文档路径
        
        For i = 0 To count - 1
            ReDim Preserve swModel2(i)
            Set swModel2(i) = swSelectionMgr.GetSelectedObjectsComponent4(i + 1, -1)
        Next i
        
        h = 0
        For i = 0 To count - 1
            If swModel2(i).GetSuppression = 1 Then swModel2(i).SetSuppression2 2
            Set swPart = swModel2(i).GetModelDoc2
            If swPart.GetType = 1 Then
                If Path_Arr.Exists(swPart.GetPathName) = False Then
                  Path_Arr(swPart.GetPathName) = ""
                  ReDim Preserve Set_Co(h)
                  Set Set_Co(h) = swPart
                  h = h + 1
                End If
            Else
                asm_get swPart '遍历子装配体内零件
            End If
        Next i
        
        Set_Bo = 2
        Label5.Caption = "已选择" & Path_Arr.count & "个<零件>对象！"
        swModel.ClearSelection2 True       '取消选择
        set_color
    End If
   
End Sub
增加了这两行代码: set_color

tg000057

igxoqve 发表于 2023-5-5 07:19
楼主有点不太地道,即然收费了就应该给完整的代码,来下载的就是想直接下下来使用,要么就是看看有没有好的方 ...

改编版和升级版均是完整代码，贴说明第6点讲了“交流使用，请谨慎下载”。

tg000057

igxoqve 发表于 2023-5-5 07:31
楼主有点不太地道,即然收费了就应该给完整的代码,来下载的就是想直接下下来使用,要么就是看看有没有好的方 ...

第一点是我这边配合宏启动器使用的，可以删除不要。第二点不用修改。