[PTM] писал(а):BoundigBox в настройках можно включить,а вот как вытащить в CAA незнаю
[PTM] писал(а):tools/options/general/display/navigatiaon/display manipulation bounding box
booSter писал(а):А какой из CAA API предполагается использовать для решения VB или C++ ?
[PTM] писал(а):tools/options/general/display/navigatiaon/display manipulation bounding box
ExtraRight писал(а):Ещё попробуйте команду "Creates Rough Stock" (найти можно через View - Command List). Правда она работает только на уровне парта вроде бы и создаёт "описывающую коробку" для тела.
bit писал(а):Если на С++ то можно посмотреть в стандартных примерах как работает CAAESmiUserOperationWithMATPComputation::GetBoundingBox
bit писал(а):Если на С++ то можно посмотреть в стандартных примерах как работает CAAESmiUserOperationWithMATPComputation::GetBoundingBox
[PTM] писал(а):замечу,что для тех у кого нет CAA можно использовать UDF
BoundingBlockUDF.CATPart
HalfBoundingBlock1UDF
более подходящую выбирайте сами.
udf находятся
..\startup\Tooling\CCV\FillingSurfaces\
Virty писал(а):Есть старенький скрипт по адресу:
http://www.2htts.com/CATBlog/index.php?itemid=24
06/07/01: Bounding Box Script - for defining material stock size
This is a script that creates an associative bounding box to a solid or joined surface. It adds 1mm wall stock and uses an axis system for orientation.
Работоспособность этого скрипта не проверял.
heze писал(а):Virty писал(а):Есть старенький скрипт по адресу:
http://www.2htts.com/CATBlog/index.php?itemid=24
06/07/01: Bounding Box Script - for defining material stock size
This is a script that creates an associative bounding box to a solid or joined surface. It adds 1mm wall stock and uses an axis system for orientation.
Работоспособность этого скрипта не проверял.
Уважаемые выложите сею реликвию у кого есть, а то ссылка не фурычит. Или может есть варианты поновее?
Sub CATMain()
Dim oCATIA As Application
Set oCATIA = CATIA
Dim oPartDocument As PartDocument
Set oPartDocument = Get_PartDocument
If oPartDocument Is Nothing Then
Exit Sub
End If
Dim oSelection As Selection
Set oSelection = oPartDocument.Selection
oSelection.Clear
Dim COGArray
COGArray = Get_COG(oPartDocument)
Dim PrincipalAxes_temp
PrincipalAxes_temp = Get_PrincipalAxes(oPartDocument)
Dim PrincipalAxes
PrincipalAxes = PrincipalAxesCorrection(PrincipalAxes_temp)
Dim oPart As part
Set oPart = oPartDocument.part
If oPart.MainBody.Shapes.Count = 0 Then
MsgBox "The PartBody Is Empty Exiting Script."
End
End If
Dim oHybridBodies As HybridBodies
Set oHybridBodies = oPart.HybridBodies
Dim oHybridBody As HybridBody
On Error Resume Next
Set oHybridBody = oHybridBodies.Item("Inertia_Bounding_Box")
If Err.Number = 0 Then
oSelection.Add oHybridBody
oSelection.Delete
oSelection.Clear
End If
On Error GoTo 0
Set oHybridBody = oHybridBodies.Add
oHybridBody.Name = "Inertia_Bounding_Box"
Dim oHybridShapeFactory As HybridShapeFactory
Set oHybridShapeFactory = oPart.HybridShapeFactory
Dim oHybridshapePointCoord As HybridShapePointCoord
Set oHybridshapePointCoord = Build_COG(oHybridShapeFactory, COGArray)
Dim InertiaAxis(2) As Line
Set InertiaAxis(0) = Build_InertiaAxis(oHybridShapeFactory, oHybridshapePointCoord, PrincipalAxes, 1)
Set InertiaAxis(1) = Build_InertiaAxis(oHybridShapeFactory, oHybridshapePointCoord, PrincipalAxes, 2)
Set InertiaAxis(2) = Build_ThirdDirection_InertiaAxis(oHybridShapeFactory, oHybridshapePointCoord, InertiaAxis(0), InertiaAxis(1))
Dim oExtremum(5) As HybridShapeExtremum
Set oExtremum(0) = Build_Extremums(oPart.MainBody, oPart, oHybridShapeFactory, 1, InertiaAxis(0), InertiaAxis(1), InertiaAxis(2))
Set oExtremum(1) = Build_Extremums(oPart.MainBody, oPart, oHybridShapeFactory, 0, InertiaAxis(0), InertiaAxis(1), InertiaAxis(2))
Set oExtremum(2) = Build_Extremums(oPart.MainBody, oPart, oHybridShapeFactory, 1, InertiaAxis(1), InertiaAxis(2), InertiaAxis(0))
Set oExtremum(3) = Build_Extremums(oPart.MainBody, oPart, oHybridShapeFactory, 0, InertiaAxis(1), InertiaAxis(2), InertiaAxis(0))
Set oExtremum(4) = Build_Extremums(oPart.MainBody, oPart, oHybridShapeFactory, 1, InertiaAxis(2), InertiaAxis(0), InertiaAxis(1))
Set oExtremum(5) = Build_Extremums(oPart.MainBody, oPart, oHybridShapeFactory, 0, InertiaAxis(2), InertiaAxis(0), InertiaAxis(1))
Dim oPolyLine As HybridShapePolyline
Set oPolyLine = Build_PolyLine(oHybridShapeFactory, oExtremum)
Dim oFinalExtremums(5) As HybridShapeExtremum
Set oFinalExtremums(0) = Build_Extremums(oPolyLine, oPart, oHybridShapeFactory, 1, InertiaAxis(0))
Set oFinalExtremums(1) = Build_Extremums(oPolyLine, oPart, oHybridShapeFactory, 0, InertiaAxis(0))
Set oFinalExtremums(2) = Build_Extremums(oPolyLine, oPart, oHybridShapeFactory, 1, InertiaAxis(1))
Set oFinalExtremums(3) = Build_Extremums(oPolyLine, oPart, oHybridShapeFactory, 0, InertiaAxis(1))
Set oFinalExtremums(4) = Build_Extremums(oPolyLine, oPart, oHybridShapeFactory, 1, InertiaAxis(2))
Set oFinalExtremums(5) = Build_Extremums(oPolyLine, oPart, oHybridShapeFactory, 0, InertiaAxis(2))
Dim oFinalPlanes(5) As HybridShapePlaneNormal
Set oFinalPlanes(0) = Build_Planes(oHybridShapeFactory, oFinalExtremums(0), InertiaAxis(0))
Set oFinalPlanes(1) = Build_Planes(oHybridShapeFactory, oFinalExtremums(1), InertiaAxis(0))
Set oFinalPlanes(2) = Build_Planes(oHybridShapeFactory, oFinalExtremums(2), InertiaAxis(1))
Set oFinalPlanes(3) = Build_Planes(oHybridShapeFactory, oFinalExtremums(3), InertiaAxis(1))
Set oFinalPlanes(4) = Build_Planes(oHybridShapeFactory, oFinalExtremums(4), InertiaAxis(2))
Set oFinalPlanes(5) = Build_Planes(oHybridShapeFactory, oFinalExtremums(5), InertiaAxis(2))
Dim oBaseLine As HybridShapeLinePtDir
Set oBaseLine = Build_LinePtDir(oHybridShapeFactory, oHybridshapePointCoord, oFinalPlanes(0), oFinalPlanes(1))
Dim oExtrudedSurface As HybridShapeExtrude
Set oExtrudedSurface = Build_ExtrudedSurface(oHybridShapeFactory, oBaseLine, oFinalPlanes(2), oFinalPlanes(3))
Dim oFinalBoundingBox As HybridShapeExtrude
Set oFinalBoundingBox = Build_ExtrudedSurface(oHybridShapeFactory, oExtrudedSurface, oFinalPlanes(4), oFinalPlanes(5))
oHybridBody.AppendHybridShape oFinalBoundingBox
End Sub
Private Function Build_ExtrudedSurface(oHybridShapeFactory As HybridShapeFactory, oAnyobject As AnyObject, oLimitPlane1 As HybridShapePlaneNormal, oLimitPlane2 As HybridShapePlaneNormal) As HybridShapeExtrude
Dim oDirection As HybridShapeDirection
Set oDirection = oHybridShapeFactory.AddNewDirection(oLimitPlane1)
Set Build_ExtrudedSurface = oHybridShapeFactory.AddNewExtrude(oAnyobject, 100, 100, oDirection)
Build_ExtrudedSurface.FirstUptoElement = oLimitPlane1
Build_ExtrudedSurface.SecondUptoElement = oLimitPlane2
Build_ExtrudedSurface.FirstLimitType = 2
Build_ExtrudedSurface.SecondLimitType = 2
Build_ExtrudedSurface.Compute
End Function
Private Function Build_LinePtDir(oHybridShapeFactory As HybridShapeFactory, oPoint As HybridShapePointCoord, oLimitPlane1 As HybridShapePlaneNormal, oLimitPlane2 As HybridShapePlaneNormal) As HybridShapeLinePtDir
Dim oDirection As HybridShapeDirection
Set oDirection = oHybridShapeFactory.AddNewDirection(oLimitPlane1)
Set Build_LinePtDir = oHybridShapeFactory.AddNewLinePtDir(oPoint, oDirection, 1000, -1000, True)
Build_LinePtDir.FirstUptoElem = oLimitPlane1
Build_LinePtDir.SecondUptoElem = oLimitPlane2
Build_LinePtDir.Compute
End Function
Private Function Build_Planes(oHybridShapeFactory As HybridShapeFactory, oFinalExtremum As HybridShapeExtremum, InertiaAxis As Line) As HybridShapePlaneNormal
Set Build_Planes = oHybridShapeFactory.AddNewPlaneNormal(InertiaAxis, oFinalExtremum)
Build_Planes.Compute
End Function
Private Function Build_PolyLine(oHybridShapeFactory As HybridShapeFactory, oExtremum) As HybridShapePolyline
Set Build_PolyLine = oHybridShapeFactory.AddNewPolyline
Dim iIndex As Integer
Dim oReference As Reference
For iIndex = 0 To UBound(oExtremum)
Build_PolyLine.InsertElement oExtremum(iIndex), iIndex + 1
Next
Build_PolyLine.Compute
Build_PolyLine.Name = "ExtremumPolyline"
End Function
Private Function Build_Extremums(oAnyobject As AnyObject, oPart As part, oHybridShapeFactory As HybridShapeFactory, MinMax As Long, hybridShapeLinePtDir1 As Line, Optional HybridShapeLinePtDir2 As Line, Optional HybridShapeLinePtDir3 As Line) As HybridShapeExtremum
Dim oHybridshapeDirection(2) As HybridShapeDirection
Set oHybridshapeDirection(0) = oHybridShapeFactory.AddNewDirection(hybridShapeLinePtDir1)
Set oHybridshapeDirection(1) = oHybridShapeFactory.AddNewDirection(HybridShapeLinePtDir2)
Set oHybridshapeDirection(2) = oHybridShapeFactory.AddNewDirection(HybridShapeLinePtDir3)
Dim oReference As Reference
Set oReference = oPart.CreateReferenceFromObject(oAnyobject)
Set Build_Extremums = oHybridShapeFactory.AddNewExtremum(oReference, oHybridshapeDirection(0), MinMax)
If Not HybridShapeLinePtDir2 Is Nothing Then
Build_Extremums.Direction2 = oHybridshapeDirection(1)
Build_Extremums.ExtremumType2 = 1
End If
If Not HybridShapeLinePtDir3 Is Nothing Then
Build_Extremums.Direction3 = oHybridshapeDirection(2)
Build_Extremums.ExtremumType3 = 1
End If
Build_Extremums.Compute
End Function
Private Function Build_ThirdDirection_InertiaAxis(oHybridShapeFactory As HybridShapeFactory, oPoint As HybridShapePointCoord, DirLine1 As HybridShapeLinePtDir, DirLine2 As HybridShapeLinePtDir) As HybridShapeLineNormal
Dim oHybridShapePlane2Lines As HybridShapePlane2Lines
Set oHybridShapePlane2Lines = oHybridShapeFactory.AddNewPlane2Lines(DirLine1, DirLine2)
oHybridShapePlane2Lines.Compute
Set Build_ThirdDirection_InertiaAxis = oHybridShapeFactory.AddNewLineNormal(oHybridShapePlane2Lines, oPoint, 10000, -10000, True)
Build_ThirdDirection_InertiaAxis.Compute
Build_ThirdDirection_InertiaAxis.Name = "InertiaAxis-3"
End Function
Private Function Build_InertiaAxis(oHybridShapeFactory As HybridShapeFactory, oPoint As HybridShapePointCoord, PrincipleAxis, InertiaAxis As Integer) As HybridShapeLinePtDir
Dim dPrincipleAxis(2) As Double
Select Case InertiaAxis
Case 1
dPrincipleAxis(0) = PrincipleAxis(0)
dPrincipleAxis(1) = PrincipleAxis(1)
dPrincipleAxis(2) = PrincipleAxis(2)
Case 2
dPrincipleAxis(0) = PrincipleAxis(3)
dPrincipleAxis(1) = PrincipleAxis(4)
dPrincipleAxis(2) = PrincipleAxis(5)
Case Else
MsgBox "Error, Value Must Be 1 or 2."
End Select
Dim oHybridshapeDirection As HybridShapeDirection
Set oHybridshapeDirection = oHybridShapeFactory.AddNewDirectionByCoord(dPrincipleAxis(0), dPrincipleAxis(1), dPrincipleAxis(2))
Set Build_InertiaAxis = oHybridShapeFactory.AddNewLinePtDir(oPoint, oHybridshapeDirection, 10000, -10000, True)
Build_InertiaAxis.Compute
Build_InertiaAxis.Name = "InertiaAxis-" & InertiaAxis
End Function
Private Function Build_COG(oHybridShapeFactory As HybridShapeFactory, COGArray) As HybridShapePointCoord
Set Build_COG = oHybridShapeFactory.AddNewPointCoord(COGArray(0) * 1000, COGArray(1) * 1000, COGArray(2) * 1000)
Build_COG.Compute
Build_COG.Name = "COG"
End Function
Private Function Get_COG(oPartDocument As PartDocument)
Dim oSPAWorkbench As SPAWorkbench
Dim oMeasureable As Measurable
Dim oInertias As Inertias
Dim oInertia 'As Inertia
Dim COGArray(2)
Set oSPAWorkbench = oPartDocument.GetWorkBench("SPAWorkbench")
Set oInertias = oSPAWorkbench.Inertias
oInertias.Add oPartDocument.part.MainBody
Set oInertia = oInertias.Item(1)
oInertia.GetCOGPosition COGArray
Get_COG = COGArray
oInertias.Remove oInertia.Name
Set oInertia = Nothing
Set oInertias = Nothing
Set oMeasureable = Nothing
Set oSPAWorkbench = Nothing
End Function
Private Function Get_PrincipalAxes(oPartDocument As PartDocument)
Dim oSPAWorkbench As SPAWorkbench
Dim oMeasureable As Measurable
Dim oInertias As Inertias
Dim oInertia 'As Inertia
Dim PrincipalAxes(8)
Set oSPAWorkbench = oPartDocument.GetWorkBench("SPAWorkbench")
Set oInertias = oSPAWorkbench.Inertias
oInertias.Add oPartDocument.part
Set oInertia = oInertias.Item(1)
oInertia.GetPrincipalAxes PrincipalAxes
Get_PrincipalAxes = PrincipalAxes
oInertias.Remove oInertia.Name
Set oInertia = Nothing
Set oInertias = Nothing
Set oMeasureable = Nothing
Set oSPAWorkbench = Nothing
End Function
Private Function PrincipalAxesCorrection(PrincipalAxes_temp)
Dim PrincipalAxes(8)
'Correct the X axis
PrincipalAxes(0) = PrincipalAxes_temp(0)
PrincipalAxes(1) = PrincipalAxes_temp(3)
PrincipalAxes(2) = PrincipalAxes_temp(6)
'Correct the Y axis
PrincipalAxes(3) = PrincipalAxes_temp(1)
PrincipalAxes(4) = PrincipalAxes_temp(4)
PrincipalAxes(5) = PrincipalAxes_temp(7)
'Correct the Z axis
PrincipalAxes(6) = PrincipalAxes_temp(2)
PrincipalAxes(7) = PrincipalAxes_temp(5)
PrincipalAxes(8) = PrincipalAxes_temp(8)
PrincipalAxesCorrection = PrincipalAxes
End Function
Private Function Get_PartDocument() As PartDocument
Dim oCATIA As Application
Dim oDocument As Document
Dim oSelection As Selection
Dim oPart As part
Set oCATIA = CATIA
On Error Resume Next
Set oDocument = CATIA.ActiveDocument
If Err.Number <> 0 Then
MsgBox "There Is No Active Document In The Current Session, Exitting Script."
End
End If
On Error GoTo 0
Set oSelection = oDocument.Selection
oSelection.Clear
'---------------------------------------------------'
If (InStr(oDocument.Name, ".CATPart")) = 0 Then
oSelection.Search ("type=Part,in")
On Error Resume Next
Set oPart = oSelection.FindObject("CATIAPart")
If Err.Number <> 0 Then
MsgBox "A Part or Part Instance Must be Active." & vbLf & "Exiting The Script"
oSelection.Clear
Exit Function
End If
On Error GoTo 0
Else
Set oPart = oDocument.part
End If
oSelection.Clear
'---------------------------------------------------'
Set Get_PartDocument = oPart.Parent
Set oPart = Nothing
Set oSelection = Nothing
Set oDocument = Nothing
Set oCATIA = Nothing
End Function
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2