|
樓主 |
發表於 2018/5/16 15:47:14
|
顯示全部樓層
翻了Help很久之後終於有解了,把原本Help旋轉的程式加點料就可以平移了但目前還是不知道怎麼自訂旋轉軸來旋轉零件
- Const PI As Double = 3.14159
- Const RadPerDeg As Double = PI / 180.0#
- Dim swModel As ModelDoc2
- Dim swModelDocExt As ModelDocExtension
- Dim swAssy As AssemblyDoc
- Dim swDragOp As DragOperator
- Dim swSelMgr As SelectionMgr
- Dim swComp As Component2
- Dim swXform As MathTransform
- Dim swMathUtil As MathUtility
- Dim swOriginPt As MathPoint
- Dim swX_Axis As MathVector
- Dim fileName As String
- Dim errors As Integer
- Dim warnings As Integer
- Dim status As Boolean
- Dim nPts(2) As Double
- Dim vData As Object
- Dim nNow As Single
- Dim i As Integer
- Dim bRet As Boolean
- fileName = "C:\Program Files\SolidWorks Corp\SolidWorks\samples\tutorial\api\assem2.sldasm"
- swModel = SwApp.OpenDoc6(fileName, swDocumentTypes_e.swDocASSEMBLY, swOpenDocOptions_e.swOpenDocOptions_Silent, "", errors, warnings)
- swModelDocExt = swModel.Extension
- status = swModelDocExt.SelectByID2("Part3^Assem2-1@assem2", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
- swAssy = swModel
- swDragOp = swAssy.GetDragOperator
- swSelMgr = swModel.SelectionManager
- swComp = swSelMgr.GetSelectedObjectsComponent2(1)
- swMathUtil = SwApp.GetMathUtility
- nPts(0) = 0.0#
- nPts(1) = 0.0#
- nPts(2) = 0.0#
- vData = nPts
- swOriginPt = swMathUtil.CreatePoint(vData)
- nPts(0) = 1.0#
- nPts(1) = 0.0#
- nPts(2) = 0.0#
- vData = nPts
- swX_Axis = swMathUtil.CreateVector(vData)
- ' This is an incremental rotation,
- ' so angle is always the same
- swXform = swMathUtil.CreateTransformRotateAxis(swOriginPt, swX_Axis, 1.0# * RadPerDeg)
- bRet = swDragOp.AddComponent(swComp, False)
- swDragOp.CollisionDetectionEnabled = False
- swDragOp.DynamicClearanceEnabled = False
- ' Axial rotation
- swDragOp.TransformType = 1
- ' Solve by relaxation
- swDragOp.DragMode = 2
- bRet = swDragOp.BeginDrag
- For i = 0 To 90
- ' Returns false if drag fails
- bRet = swDragOp.Drag(swXform)
- ' Wait for 0.1 secs
- '____________________________________零組件平移_______________________________
- '定義移動距離(Unit:Meter)
- Dim X_move, Y_move, Z_move As Double
- '定義平移矩陣
- Dim swXformMove As MathTransform = swMathUtil.CreateTransform({1, 0, 0, 0, 1, 0, 0, 0, 1, X_move, Y_move, Z_move, 1, 0, 0, 0})
- '移動零組件
- swComp.Transform2 = swXformMove
- '重新計算文件
- bRet = swModel.EditRebuild3
- '_____________________________________________________________________________
- nNow = DateAndTime.Timer
- While DateAndTime.Timer < nNow + 0.1
- ' Process event loop
- DoEvents()
- End While
- Next i
- bRet = swDragOp.EndDrag
複製代碼
|
|