hoangthe
Mechanical
- May 5, 2021
- 17
I have a 3D object, and now I want to automatically generate a front view using a macro. However, the projection is tilted. Is there any way to make the projection straight?
Sub CATMain()
On Error Resume Next
Dim oPartDoc As PartDocument
Dim oCurrentDoc As Document
Dim oPart As Product
Dim oInertia As Inertia
Dim InputObjectType(1) As Variant
Dim Status As String
Dim oSelection As Variant
Dim bCloseDoc As Boolean
Set oCurrentDoc = CATIA.ActiveDocument
'Exclude Drawings
If Right(oCurrentDoc.Name, 4) = "wing" Then
MsgBox "This function only operates on a part or product"
Exit Sub
End If
Set oSelection = oCurrentDoc.Selection
If Right(oCurrentDoc.Name, 4) = "Part" Then
Set oPart = oCurrentDoc.Product
CATIA.HSOSynchronized = False
oSelection.CLEAR
oSelection.Add oPart
'GoTo RunBBOpenWindow
End If
If Right(oCurrentDoc.Name, 4) = "duct" Then
bCloseDoc = True
InputObjectType(0) = "Part"
InputObjectType(1) = "Product"
oSelection.Clear
Status = oSelection.SelectElement2(InputObjectType, "Pick a Part, Escape to Cancel", False)
If Status = "Cancel" Then Exit Sub
Set oPart = oSelection.Item2(1).LeafProduct.ReferenceProduct
If oPart.Name = oCurrentDoc.Product.Name Then
bCloseDoc = False
'GoTo RunBBOpenWindow
End If
CATIA.StartCommand "open in new window"
End If
RunBBNewWindow:
Set oPart = CATIA.ActiveDocument.Product
Dim oSelection2
Set oSelection2 = CATIA.ActiveDocument.Selection
oSelection2.Add oPart
RunBBOpenWindow:
CATIA.StartCommand "Measure Inertia"
Dim xDim As String
Dim yDim As String
Dim zDim As String
Dim xDim2 As String
Dim yDim2 As String
Dim zDim2 As String
xDim = oPart.Parameters.GetItem("A1x").Value
yDim = oPart.Parameters.GetItem("A1y").Value
zDim = oPart.Parameters.GetItem("A1z").Value
xDim2 = oPart.Parameters.GetItem("A2x").Value
yDim2 = oPart.Parameters.GetItem("A2y").Value
zDim2 = oPart.Parameters.GetItem("A2z").Value
'xDim = CStr(Round(xDim, 0))
'yDim = CStr(Round(yDim, 0))
'zDim = CStr(Round(zDim, 0))
Dim oMatParam As Parameter
Dim sMatParam As String
Set oMatParam = oPart.Parameters.GetItem("Definition")
sMatParam = oMatParam.ValueAsString
CATIA.StatusBar = "Start Creating Params"
Set documents1 = CATIA.Documents
Set drawingDocument1 = documents1.Add("Drawing")
Set drawingSheets1 = drawingDocument1.Sheets
Set drawingSheet1 = drawingSheets1.Item("Sheet.1")
Set drawingViews1 = drawingSheet1.Views
Set drawingView1 = drawingViews1.Add("AutomaticNaming")
Set drawingViewGenerativeLinks1 = drawingView1.GenerativeLinks
Set drawingViewGenerativeBehavior1 = drawingView1.GenerativeBehavior
'Set partDocument1 = documents1.Item("Part4.CATPart")
'Set product1 = partDocument1.GetItem("Part4")
Set prod = oCurrentDoc.Product
drawingViewGenerativeBehavior1.Document = prod
drawingViewGenerativeBehavior1.DefineFrontView xDim, yDim, zDim, xDim2, yDim2, zDim2
Set drawingViewGenerativeBehavior1 = drawingView1.GenerativeBehavior
drawingViewGenerativeBehavior1.Update
If bCloseDoc = True Then CATIA.ActiveDocument.Close
CATIA.StatusBar = "Macro Finished"
End Sub
Sub SetParam(ByRef oPart As Product, Name As String, Value As String)
'On Error GoTo CreateParam
Dim sParam As Parameter
Err.Clear
Set sParam = oPart.UserRefProperties.GetItem(Name)
sParam.ValuateFromString CStr(Value)
'GoTo Finish
CreateParam:
oPart.UserRefProperties.CreateString Name, CStr(Value)
Finish:
End Sub
Sub CATMain()
On Error Resume Next
Dim oPartDoc As PartDocument
Dim oCurrentDoc As Document
Dim oPart As Product
Dim oInertia As Inertia
Dim InputObjectType(1) As Variant
Dim Status As String
Dim oSelection As Variant
Dim bCloseDoc As Boolean
Set oCurrentDoc = CATIA.ActiveDocument
'Exclude Drawings
If Right(oCurrentDoc.Name, 4) = "wing" Then
MsgBox "This function only operates on a part or product"
Exit Sub
End If
Set oSelection = oCurrentDoc.Selection
If Right(oCurrentDoc.Name, 4) = "Part" Then
Set oPart = oCurrentDoc.Product
CATIA.HSOSynchronized = False
oSelection.CLEAR
oSelection.Add oPart
'GoTo RunBBOpenWindow
End If
If Right(oCurrentDoc.Name, 4) = "duct" Then
bCloseDoc = True
InputObjectType(0) = "Part"
InputObjectType(1) = "Product"
oSelection.Clear
Status = oSelection.SelectElement2(InputObjectType, "Pick a Part, Escape to Cancel", False)
If Status = "Cancel" Then Exit Sub
Set oPart = oSelection.Item2(1).LeafProduct.ReferenceProduct
If oPart.Name = oCurrentDoc.Product.Name Then
bCloseDoc = False
'GoTo RunBBOpenWindow
End If
CATIA.StartCommand "open in new window"
End If
RunBBNewWindow:
Set oPart = CATIA.ActiveDocument.Product
Dim oSelection2
Set oSelection2 = CATIA.ActiveDocument.Selection
oSelection2.Add oPart
RunBBOpenWindow:
CATIA.StartCommand "Measure Inertia"
Dim xDim As String
Dim yDim As String
Dim zDim As String
Dim xDim2 As String
Dim yDim2 As String
Dim zDim2 As String
xDim = oPart.Parameters.GetItem("A1x").Value
yDim = oPart.Parameters.GetItem("A1y").Value
zDim = oPart.Parameters.GetItem("A1z").Value
xDim2 = oPart.Parameters.GetItem("A2x").Value
yDim2 = oPart.Parameters.GetItem("A2y").Value
zDim2 = oPart.Parameters.GetItem("A2z").Value
'xDim = CStr(Round(xDim, 0))
'yDim = CStr(Round(yDim, 0))
'zDim = CStr(Round(zDim, 0))
Dim oMatParam As Parameter
Dim sMatParam As String
Set oMatParam = oPart.Parameters.GetItem("Definition")
sMatParam = oMatParam.ValueAsString
CATIA.StatusBar = "Start Creating Params"
Set documents1 = CATIA.Documents
Set drawingDocument1 = documents1.Add("Drawing")
Set drawingSheets1 = drawingDocument1.Sheets
Set drawingSheet1 = drawingSheets1.Item("Sheet.1")
Set drawingViews1 = drawingSheet1.Views
Set drawingView1 = drawingViews1.Add("AutomaticNaming")
Set drawingViewGenerativeLinks1 = drawingView1.GenerativeLinks
Set drawingViewGenerativeBehavior1 = drawingView1.GenerativeBehavior
'Set partDocument1 = documents1.Item("Part4.CATPart")
'Set product1 = partDocument1.GetItem("Part4")
Set prod = oCurrentDoc.Product
drawingViewGenerativeBehavior1.Document = prod
drawingViewGenerativeBehavior1.DefineFrontView xDim, yDim, zDim, xDim2, yDim2, zDim2
Set drawingViewGenerativeBehavior1 = drawingView1.GenerativeBehavior
drawingViewGenerativeBehavior1.Update
If bCloseDoc = True Then CATIA.ActiveDocument.Close
CATIA.StatusBar = "Macro Finished"
End Sub
Sub SetParam(ByRef oPart As Product, Name As String, Value As String)
'On Error GoTo CreateParam
Dim sParam As Parameter
Err.Clear
Set sParam = oPart.UserRefProperties.GetItem(Name)
sParam.ValuateFromString CStr(Value)
'GoTo Finish
CreateParam:
oPart.UserRefProperties.CreateString Name, CStr(Value)
Finish:
End Sub