iCAx开思网

标题: 請問如何用catia的VBA量測角度? [打印本页]

作者: lime0927 时间: 2004-9-9 22:06
标题: 請問如何用catia的VBA量測角度?
我想要量測兩線段的夾角度數不知要如何寫

我附上程式碼希望能有高手幫我看一下

我是在造型模組下做3點兩直線然後要量這兩直線的夾角

以下是程式碼

Sub CATMain()
********************以下畫3點兩直線
Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridShapePointCoord1 As HybridShapePointCoord
Set hybridShapePointCoord1 = hybridShapeFactory1.AddNewPointCoord(0#, 0#, 100#)

Dim bodies1 As Bodies
Set bodies1 = part1.Bodies

Dim body1 As Body
Set body1 = bodies1.Item("

artBody")

body1.InsertHybridShape hybridShapePointCoord1

part1.InWorkObject = hybridShapePointCoord1

part1.Update

Dim hybridShapePointCoord2 As HybridShapePointCoord
Set hybridShapePointCoord2 = hybridShapeFactory1.AddNewPointCoord(0#, 100#, 100#)

body1.InsertHybridShape hybridShapePointCoord2

part1.InWorkObject = hybridShapePointCoord2

part1.Update

Dim hybridShapePointCoord3 As HybridShapePointCoord
Set hybridShapePointCoord3 = hybridShapeFactory1.AddNewPointCoord(100#, 100#, 100#)

body1.InsertHybridShape hybridShapePointCoord3

part1.InWorkObject = hybridShapePointCoord3

part1.Update

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1)

Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(hybridShapePointCoord3)

Dim hybridShapeLinePtPt1 As HybridShapeLinePtPt
Set hybridShapeLinePtPt1 = hybridShapeFactory1.AddNewLinePtPt(reference1, reference2)

body1.InsertHybridShape hybridShapeLinePtPt1

part1.InWorkObject = hybridShapeLinePtPt1

part1.Update

Dim reference3 As Reference
Set reference3 = part1.CreateReferenceFromObject(hybridShapePointCoord1)

Dim reference4 As Reference
Set reference4 = part1.CreateReferenceFromObject(hybridShapePointCoord2)

Dim hybridShapeLinePtPt2 As HybridShapeLinePtPt
Set hybridShapeLinePtPt2 = hybridShapeFactory1.AddNewLinePtPt(reference3, reference4)

body1.InsertHybridShape hybridShapeLinePtPt2

part1.InWorkObject = hybridShapeLinePtPt2

part1.Update
******************以下量測兩線段夾角
Dim reference5 As Reference
Set reference5 = part1.CreateReferenceFromObject(hybridShapeLinePtPt1)
Dim reference6 As Reference
Set reference6 = part1.CreateReferenceFromObject(hybridShapeLinePtPt2)
dim reference9 AS string
set reference9=CATIA.GetWorkbenchId
Dim TheSPAWorkbench As Workbench
TheSPAWorkbench = partDocument1.GetWorkbench("reference9")
Dim TheMeasurable As Measurable
Set TheMeasurable = TheSPAWorkbench.Measurable(reference5)
Dim Angle As Double
Angle = TheMeasurable.GetAngleBetween(reference6)

MsgBox "CATShapeDesignWorkbench=" & CStr(Angle)

End Sub

作者: zhaxia 时间: 2004-9-10 15:54

lime0927 wrote:
  ******************以下量測兩線段夾角
  Dim reference5 As Reference
  Set reference5 = part1.CreateReferenceFromObject(hybridShapeLinePtPt1)
  Dim reference6 As Reference
  Set reference6 = part1.CreateReferenceFromObject(hybridShapeLinePtPt2)
  Dim TheSPAWorkbench As Workbench
  TheSPAWorkbench = partDocument1.GetWorkbench("CATShapeDesignWorkbench")
  Dim TheMeasurable As Measurable
  Set TheMeasurable = TheSPAWorkbench.Measurable(reference5)
  Dim Angle As Double
  Angle = TheMeasurable.GetAngleBetween(reference6)
  
  MsgBox "CATShapeDesignWorkbench=" & CStr(Angle)
  
  End Sub

上面那句改为 Set TheMeasurable = TheSPAWorkbench.getMeasurable(reference5)

作者: lime0927 时间: 2004-9-10 22:42
我改了還是沒辦法量到角度......真傷腦筋阿.....
但是還是十分感謝zhaxia的回答.......因為問了很久都沒有人回答我這個問題

******************以下量測兩線段夾角
Dim reference5 As Reference
Set reference5 = part1.CreateReferenceFromObject(hybridShapeLinePtPt1)
Dim reference6 As Reference
Set reference6 = part1.CreateReferenceFromObject(hybridShapeLinePtPt2)
Dim TheSPAWorkbench As Workbench
Set TheSPAWorkbench = partDocument1.GetWorkbench("CATShapeDesignWorkbench")
Dim TheMeasurable As Measurable
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(reference5)
Dim Angle As Double
Angle = TheMeasurable.GetAngleBetween(reference6)
   
MsgBox "CATShapeDesignWorkbench=" & CStr(Angle)
   
End Sub

作者: lime0927 时间: 2004-9-10 23:43
搞定了.....謝謝zhaxia

作者: huangsteve 时间: 2007-4-1 20:10
请教你的vba测量是什么解决的？
我有时候可以测量，有时候促能测量。
该怎么办呢、
谢谢楼主
我得联系方式
huangsteve@163.com
5849182

作者: 射雕英雄赚 时间: 2012-5-18 09:14
到底怎么做的，为什么我的TheSPAWorkbench后面没有GetMeasurable?

欢迎光临 iCAx开思网 (https://www.icax.org/)