求救~~關於SW的API (修改原程式碼)

fang9595

你可參照下面程式碼，並貼於vb中，但需增加"引用項目 "

Option Explicit '強制宣告
Sub main()

'Dim swApp As Object    '改成下行 '若是在VB要設定"引用項目"
Dim swApp As SldWorks.SldWorks

'Dim Part As Object    '改成下行
Dim Part As SldWorks.ModelDoc2

Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Set swApp = CreateObject("Sldworks.application")
Set Part = swApp.ActiveDoc

Set Part = swApp.NewDocument("C:\Program Files\SolidWorks Corp\SolidWorks\lang\chinese\Tutorial\part.prtdot", 0, 0, 0)  ''改成下行
'Set Part = swApp.NewDocument("C:\Program Files\SolidWorks\lang\chinese\Tutorial\part.prtdot", 0, 0, 0)  '我的是2006版，樣版路徑如左，請自行調整
'Set Part = swApp.NewDocument("C:\Program Files\SolidWorks Corp\SolidWorks\lang\chinese\Tutorial\part.prtdot", 0, 0, 0) '我的是2009版，樣版路徑如左，請自行調整

Set Part = swApp.ActivateDoc2("零件1", False, longstatus)   '這裡請留意流水號


'Set SelMgr = Part.SelectionManager     '沒有用到的物件
boolstatus = Part.Extension.SelectByID2("右基準面", "PLANE", 0, 0, 0, False, 0, Nothing, 0) '線徑及中心徑

'Part.SketchManager.InsertSketch True   '改成下行
Part.InsertSketch2 True

Part.ClearSelection2 True

'你設定參數
Dim D As Double
Dim R As Double
'D = 1.22
'R = 0.23
D = 0.0122
R = 0.0023

Part.CreateLine2(0, 0, 0, 0, D, 0).ConstructionGeometry = True  '劃出長度為D的中心線
'Part.CreateCircle 0, D, 0, R, D, 0  '以(0,D,0)為圓心畫出一個半徑為R的圓形     '改成下行
Part.CreateCircle2 0, D, 0, R, D, 0  '以(0,D,0)為圓心畫出一個半徑為R的圓形

'Set SelMgr = Part.SelectionManager '沒有用到的物件
'Part.SketchManager.InsertSketch True '改成下行
Part.InsertSketch2 True
End Sub

另外這檔案為macro，我測試於2006與2009版，結果是成功的 Macro10.swp (42 KB, 下載次數: 128)

2010/11/30 15:29 上傳

點擊文件名下載附件

。

武大郎-old

你是放問題 還是教學