Private Sub cmd_Apply_Click()
Dim dblDensity As Double, strMassProp As String, strTemp As String
' on selection of Apply or Exit & Save button delete existing custom properties
' and recreate with new values
If chkStore.Value = 1 Then Call cmdStore_Click
'Deleting all custom properties to keep files clean
'from part and assembly
retval = swCustPropMgrPP.Delete("Title")
retval = swCustPropMgr.Delete("Title")
retval = swCustPropMgr.Delete("Machine")
retval = swCustPropMgr.Delete("Description")
retval = swCustPropMgr.Delete("Description_1")
retval = swCustPropMgr.Delete("Vendor")
retval = swCustPropMgrPP.Delete("Weight")
retval = swCustPropMgr.Delete("Material")
retval = swCustPropMgr.Delete("Finish")
retval = swCustPropMgr.Delete("HeatTreatment")
retval = swCustPropMgr.Delete("Designby")
retval = swCustPropMgr.Delete("DesignDate")
retval = swCustPropMgr.Delete("Design")
retval = swCustPropMgr.Delete("Design_Date")
retval = swCustPropMgr.Delete("CatName")
retval = swCustPropMgr.Delete("Catno")
retval = swCustPropMgr.Delete("O'Hara_PartNumber")
'if $_Part_Type present delete it
retval = swCustPropMgr.Delete("$_Part_Type")
'from purchase part
retval = swCustPropMgrPP.Delete("Supplier_No")
retval = swCustPropMgrPP.Delete("VendorNo")
retval = swCustPropMgr.Delete("Supplier")
retval = swCustPropMgrPP.Delete("O'Hara_PartNumber")
Select Case sCatg
Case "PART"
'Adding new values to the part custom properties.
strTitle = UCase(txtTitle.Text)
retval = swCustPropMgr.Add2("Description", swCustomInfoText, strTitle)
retval = Part.SetMaterialPropertyName(sMatDB, UCase(cboMaterial.Text))
If Not retval Then retval = Part.SetMaterialPropertyName("solidworks materials.sldmat", UCase(cboMaterial.Text))
If Not retval Then retval = Part.SetMaterialPropertyName("ss solidworks materials.sldmat", UCase(cboMaterial.Text))
If retval Then
strTemp = Chr(34) & "SW-Material@" & doctitle & Chr(34)
Else
strTemp = UCase(cboMaterial.Text)
' retval = Part.RemoveMaterialProperty()
End If
retval = swCustPropMgr.Add2("Material", swCustomInfoText, strTemp)
retval = swCustPropMgr.Add2("Machine", swCustomInfoText, UCase(cboMachine.Text))
retval = swCustPropMgr.Add2("Finish", swCustomInfoText, UCase(cboFinish.Text))
retval = swCustPropMgr.Add2("Designby", swCustomInfoText, UCase(cboDesignBy.Text))
retval = swCustPropMgr.Add2("DesignDate", swCustomInfoText, UCase(txtDesignDate.Text))
retval = swCustPropMgr.Add2("O'Hara_PartNumber", swCustomInfoText, UCase(txtOHARAPN.Text))
'end of part processing
'start assembly
Case "ASSEMBLY"
'Adding new values to the part custom properties.
strTitle = UCase(txtTitle.Text)
retval = swCustPropMgr.Add2("Description", swCustomInfoText, strTitle)
retval = swCustPropMgr.Add2("Machine", swCustomInfoText, UCase(cboMachine.Text))
retval = swCustPropMgr.Add2("Material", swCustomInfoText, UCase(cboMaterial.Text))
retval = swCustPropMgr.Add2("Finish", swCustomInfoText, UCase(cboFinish.Text))
retval = swCustPropMgr.Add2("Designby", swCustomInfoText, UCase(cboDesignBy.Text))
retval = swCustPropMgr.Add2("DesignDate", swCustomInfoText, UCase(txtDesignDate.Text))
retval = swCustPropMgr.Add2("O'Hara_PartNumber", swCustomInfoText, UCase(txtOHARAPN.Text))
'end assembly processing
'start purchase part
Case "PURCHASE"
'Adding new values to the part custom properties.
retval = swCustPropMgr.Add2("$_Part_Type", swCustomInfoText, "P")
retval = swCustPropMgr.Add2("Supplier", swCustomInfoText, UCase(cboSupplier.Text))
retval = swCustPropMgr.Add2("Description", swCustomInfoText, UCase(txtPartName.Text))
retval = swCustPropMgrPP.Add2("VendorNo", swCustomInfoText, UCase(txtSuppPartNo.Text))
retval = swCustPropMgrPP.Add2("O'Hara_PartNumber", swCustomInfoText, UCase(txtOHARAPNPP.Text))
'add material if requested
If chkAddMat.Value = 1 Then
retval = Part.SetMaterialPropertyName(sMatDB, UCase(cboMatPP.Text))
If Not retval Then retval = Part.SetMaterialPropertyName("solidworks materials.sldmat", UCase(cboMatPP.Text))
If Not retval Then retval = Part.SetMaterialPropertyName("ss solidworks materials.sldmat", UCase(cboMatPP.Text))
If retval Then
strTemp = Chr(34) & "SW-Material@" & doctitle & Chr(34)
Else
strTemp = UCase(cboMatPP.Text)
' retval = Part.RemoveMaterialProperty()
End If
retval = swCustPropMgr.Add2("Material", swCustomInfoText, strTemp)
End If
Set Config = Part.GetActiveConfiguration()
Config.AlternateName = UCase(txtSuppPartNo.Text) ' make " " for blank in part no.
Config.UseAlternateNameInBOM = True
'end processing purchase part
End Select
retval = Part.EditRebuild3
End Sub