SW關于輸出曲面點陣到txt文檔的宏代碼

oy87188

: n$ P0 f5 j) B* c: p6 ~
尊敬的各位大佬，本人是SW使用的小白，最近在調試SW的宏代碼時，想通過宏代碼將曲面上的點陣輸出到txt中，從而方便后續(xù)處理。但是遇到了如下的問題：顯示對應變量未定義，還望各位大佬多多指點一二？
1 l( G: o! v5 N7 Y, Z) c5 o附上對應的代碼如下：（壓縮包內為swp文件）
3 ?+ U( y9 j! k

; b7 ]+ j# ]' M1 g8 l
2 b1 p& \  _2 c: H' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' 輸出曲面上某些點到Txt文件中
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub main()
    Dim swApp As SldWorks.SldWorks
0 C2 @# j8 U0 b. B+ R- }    Dim myModel As SldWorks.ModelDoc2
" |! c$ `7 Z- t6 T. B' W    Dim mathUtils As SldWorks.MathUtility
    Dim nStart As Single
0 I! Q6 j6 v2 B# g3 F) a5 [+ K5 U        nStart = Timer
% w' S: H4 a! \7 R' H    Set swApp = Application.SldWorks
    Set myModel = swApp.ActiveDoc
! T+ v) R' M- C$ j$ n    Set mathUtils = swApp.GetMathUtility()
    ' 以下遍歷22x22個投影點
2 b+ v9 y5 c& a/ n    Dim i As Integer
    Dim j As Integer
    For i = 0 To 21
    For j = 0 To 21
    ' 預先指定一個被投影面
9 U2 ?5 d8 q/ }    Dim mySelMgr As SldWorks.SelectionMgr
3 F0 `( l# Q2 U" Q- x+ p    Dim selObj As Object
- W$ o, T( ^" n) I& F) E, _    Dim faceToUse As SldWorks.Face2
    Dim surfaceToUse As SldWorks.Surface
2 Q% t: f9 l0 u# X/ |' O" Q    Dim selCount As Long
6 N2 ]: b! }; `* P8 v/ E9 j; V    Dim selType As Long
    Set mySelMgr = myModel.SelectionManager
* e3 {) v! h) a* E3 Y        selCount = mySelMgr.GetSelectedObjectCount2(0)
9 D/ l8 Z# u( G4 h, U$ j3 Z5 U        If (selCount > 0) Then
        selType = mySelMgr.GetSelectedObjectType3(1, 0)
    Set selObj = mySelMgr.GetSelectedObject6(1, 0)
        If (selType = SwConst.swSelFACES) Then
        Set faceToUse = selObj
        End If
    End If
    ' 定義投影向量
    Dim basePoint(0 To 2) As Double, rayDir(0 To 2) As Double
    Dim vBasePoint As Variant, vVector As Variant
+ O9 H. A' U) O& }+ T    Dim rayPoint As SldWorks.MathPoint, rayVector As SldWorks.MathVector
    Dim intersectPt As SldWorks.MathPoint
    Dim vPoint As Variant, vPoint2 As Variant
: C% c  L6 a2 G% A& f    Dim xPt As Double, yPt As Double, zPt As Double
0 B" b$ \& ]% ~; r, A' A. x& o4 ]1 o/ q    ' 先對曲面的情況進行投影； First try the face
! q3 U) \7 r+ ~6 W8 x' p        If Not faceToUse Is Nothing Then
3 C* H# T* _5 n# b. _! [        basePoint(0) = i * 0.125 '
* m6 G! w* }0 ~$ A% ?4 f- D        basePoint(1) = j * 0.125 '
        basePoint(2) = 1#
! r. _( `. t( U" v8 d  k! A        vBasePoint = basePoint
' z: I# A; h- _( S6 [4 Q    Set rayPoint = mathUtils.CreatePoint(vBasePoint)
        rayDir(0) = 0#
( h$ N4 @3 T& z' ~5 v3 c$ ~  s        rayDir(1) = 0#
0 a1 c2 P! g- y& O; j$ d% K        rayDir(2) = -1#
        vVector = rayDir
    Set rayVector = mathUtils.CreateVector(vVector)
    Set intersectPt = faceToUse.GetProjectedPointOn(rayPoint, rayVector)
  z  |4 k5 _% n/ U; Y    If Not intersectPt Is Nothing Then
3 t8 y8 e$ ?0 `" r9 s+ d4 `        vPoint = intersectPt.ArrayData
  p% d  u2 x- C. B3 K# b        xPt = vPoint(0)
        yPt = vPoint(1)
        zPt = vPoint(2)
        清單輸出窗口.LIST.Text = 清單輸出窗口.LIST.Text & Format(xPt * 1000, "##0.0#####") & " ,"

        清單輸出窗口.LIST.Text = 清單輸出窗口.LIST.Text & Format(yPt * 1000, "##0.0#####") & " ,"
  k1 P8 q( t1 {- H8 P/ D
* {+ V/ X/ }8 v! M. L" C8 _        清單輸出窗口.LIST.Text = 清單輸出窗口.LIST.Text & Format(zPt * 1000, "##0.0#####") & " " & vbCrLf
    Else
; f$ H& ?# l( ^5 ^( r( z" x5 o        清單輸出窗口.LIST.Text = 清單輸出窗口.LIST.Text & Format(zPt * 1000, "##0.0#####") & " " & vbCrLf    '(j * 125, "##0.0#####") & " , 0" & "   " & vbCrLf '控制是否輸出未投影到曲面上的點位 " No face hit point."
  g, J5 K5 W9 ]4 h      End If
    End If
: R" u5 @  Z$ n5 u    Next j
    Next i

    清單輸出窗口.計算耗用時間.Text = Round(Timer) - Round(nStart) & "秒"
    清單輸出窗口.Show
3 B8 Q  O7 V6 P5 _/ X+ D/ o- OEnd Sub

Public Sub Delayms(lngTime As Long) '延時程序調用-測試時用
! Q. u" ^3 R4 h4 fDim StartTime As Single
$ {8 h: f8 N; [& ~/ _Dim CostTime As Single
StartTime = Timer
. Q+ V: `8 T: ]) G% O7 ADo While (Timer - StartTime) * 1000 < lngTime
9 c% x3 ^- V) w. h* FDoEvents
Loop
, T; J" x7 ]& MSet swApp = Application.SldWorks
End Sub

2 b7 n; z0 e; ~- L3 K  U) B
4 G! x; h: C9 f4 Q1 N6 j
+ `& Q( }! \0 b3 u; j" ~) s

喂我袋鹽

支持

劉大官人

盲區(qū)

吳嗒嗒

牛逼，這是什么東西？你們這時solidwork直接對接生產嗎？