-
Re: how to remove color on the face
Artem Taturevych Sep 28, 2016 11:33 PM (in response to xianbin Huang)Works correctly for me with your code. Can you attach the model and what is your SW version?
-
Re: how to remove color on the face
xianbin Huang Sep 29, 2016 2:02 AM (in response to Artem Taturevych)OK , thank you ,let me try it and check it again
-
Re: how to remove color on the face
xianbin Huang Sep 29, 2016 10:01 PM (in response to Artem Taturevych)已更新 Hi Artem
I write a code to add a subconfiguration and remove all color for this active configuration,now i use the callresel to add color for the face that i select.but the color on the face of other configuration will be lose.
You can run the CreMfgSubConfig_onOK code before choose two face on the active configuration.
and you can download the file by the attachment.
Dim isFaceSel As Boolean
Dim swapp As SldWorks.SldWorks
Dim swSelMgr As SldWorks.SelectionMgr
Dim myFaceColl As Collection
Dim myEdgeColl As Collection
Dim myVertColl As Collection
Dim myPlaneColl As Collection
Dim swDoc As SldWorks.ModelDoc2
Dim myEnt As SldWorks.Entity
Dim mySafeEnt As SldWorks.Entity
Dim myFeat As SldWorks.Feature
Public configName As String
Public Sub CreMfgSubConfig_onOK()
Initialize_swSelection
Call SaveSels(False)
If isFaceSel = False Then Exit Sub
addSubConfig
RemoveAllColor '2016-8-7 去掉子配置里的颜色,然后再添加新的颜色
Call ReSel(False)
addColor
End Sub
Public Function addSubConfig() As Boolean
addSubConfig = True
Dim swapp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swconfig As SldWorks.Configuration
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swSubConfig As SldWorks.Configuration
Set swapp = Application.SldWorks
Set swModel = swapp.ActiveDoc
Set swconfig = swModel.GetActiveConfiguration
Set swConfigMgr = swModel.ConfigurationManager
Set swSubConfig = swConfigMgr.AddConfiguration("subMfgName", "", "", 1, swconfig.Name, "Mfg by ICT API")
swModel.EditRebuild3
End Function
Public Sub RemoveAllColor()
Dim swapp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPrt As SldWorks.PartDoc
Dim swconfig As SldWorks.Configuration
Dim ConfigNames As Variant
Dim swBodies() As SldWorks.Body2
Dim swBody As SldWorks.Body2
Dim vBody As Variant
Dim vBodyArr As Variant
Dim path As String
Dim vconfigname As String
Dim swFaces() As Face2
Dim swFace As Face2
Dim vFace As Variant
Dim vprops As Variant
Dim bRet As Boolean
Set swapp = Application.SldWorks
Set swModel = swapp.ActiveDoc
Set swPrt = swModel
swBodies = swPrt.GetBodies2(swAllBodies, True)
For Each vBody In swBodies
Set swBody = vBody
swFaces = swBody.GetFaces()
For Each vFace In swFaces
Set swFace = vFace
bRet = swFace.RemoveMaterialProperty2(1, Empty)
Next
Next
End Sub
Public Sub addColor()
Dim swapp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelExt As SldWorks.ModelDocExtension
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFace As SldWorks.Face2
Dim Faces() As SldWorks.Face2
Dim vprops(8) As Double
Dim bRet As Boolean
Set swapp = Application.SldWorks
Set swModel = swapp.ActiveDoc
Set swModelExt = swModel.Extension
If swModelExt.LinkedDisplayState = False Then
MsgBox "显示状态未设置链接至配置"
swModelExt.LinkedDisplayState = True
MsgBox swModelExt.LinkedDisplayState & " ( " & "设置成功)"
End If
Set swSelMgr = swModel.SelectionManager
Dim vFaces As Variant
Dim i As Integer
vprops(0) = 1
vprops(1) = 0
vprops(2) = 1
vprops(3) = 1
vprops(4) = 1
vprops(5) = 0.8
vprops(6) = 0.3125
vprops(7) = 0
vprops(8) = 0
For i = 1 To swSelMgr.GetSelectedObjectCount2(0)
Set swFace = swSelMgr.GetSelectedObject6(i, -1)
swFace.SetMaterialPropertyValues2 vprops, swInConfigurationOpts_e.swThisConfiguration, Empty
Next i
swModel.ClearSelection2 True
End Sub
Sub Initialize_swSelection()
Set swapp = Application.SldWorks
Set swDoc = swapp.ActiveDoc
Set swSelMgr = swDoc.SelectionManager
Set myFaceColl = New Collection
End Sub
Private Sub SaveSels(bAdd As Boolean)
Dim i As Long
isFaceSel = False
If Not bAdd Then
Set myFaceColl = New Collection
End If
For i = 1 To swSelMgr.GetSelectedObjectCount
If swSelMgr.GetSelectedObjectType3(i, -1) = swSelFACES Then
isFaceSel = True
Set myEnt = swSelMgr.GetSelectedObject6(i, -1)
myFaceColl.Add myEnt.GetSafeEntity
End If
Next i
If isFaceSel = False Then
MsgBox "没有面被选中"
Exit Sub
End If
End Sub
Private Sub ReSel(bAdd As Boolean)
If Not (swapp.ActiveDoc Is swDoc) Then
MsgBox "The currently saved set is not in this document."
Exit Sub
End If
If Not bAdd Then
swDoc.ClearSelection2 True
End If
For Each myEnt In myFaceColl
If myEnt.Select(True) Then
Else
' Me.labMissingFaces.Caption = Me.labMissingFaces.Caption + 1
End If
Next
End Sub
-
Re: how to remove color on the face
Artem Taturevych Sep 29, 2016 10:18 PM (in response to xianbin Huang)Yes, I see it now, seems like a BUG to me. Actually when i try to remove the color from the face from the UI - it doesn't allow me to: color is removed but returned after the rebuild:
There seems to be only fails for the faces you will be reassigning the colors (all other faces preserve the colors). So probably if you skip removing the color from selected faces but just assign the new color - this should fix the issue.
-
Re: how to remove color on the face
xianbin Huang Sep 29, 2016 10:39 PM (in response to Artem Taturevych)Hi artem
Do you have some idea to fix it ?
in the subconfiguration that i created by the code,it should be remove all color it ,and i assign the new color for the selected faces.
But now other configuration ,if the face is same to i choose in other configuration ,the color of the face will be losed. how to do it ?
-
-
-
-
Re: how to remove color on the face
Deepak Gupta Sep 29, 2016 12:39 AM (in response to xianbin Huang)Please upload files directly here and avoid using external links.
Check #18 of Forum Posting on how to attach files while replying to a post.