SW关于输出曲面点阵到txt文档的宏代码

oy87188

% }8 O9 O7 n4 G- c- [( C2 |+ V) H1 d8 d尊敬的各位大佬，本人是SW使用的小白，最近在调试SW的宏代码时，想通过宏代码将曲面上的点阵输出到txt中，从而方便后续处理。但是遇到了如下的问题：显示对应变量未定义，还望各位大佬多多指点一二？
. W. J: j+ N2 U) E  Q# q2 F3 A2 B附上对应的代码如下：（压缩包内为swp文件）
9 x+ u1 e7 U3 E/ P


' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  o$ t( P2 X/ l# H  u; x1 b: j9 i' 输出曲面上某些点到Txt文件中
, @4 c; I! y) w/ `' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub main()
0 x0 P* t1 S% M5 B6 K0 k0 a* ~& d    Dim swApp As SldWorks.SldWorks
    Dim myModel As SldWorks.ModelDoc2
/ I/ U2 F# ]1 A3 `. G    Dim mathUtils As SldWorks.MathUtility
    Dim nStart As Single
        nStart = Timer
, M; v3 H' X! Y! |" J; v) v    Set swApp = Application.SldWorks
    Set myModel = swApp.ActiveDoc
    Set mathUtils = swApp.GetMathUtility()
! W' W! v. i" J1 i% m    ' 以下遍历22x22个投影点
    Dim i As Integer
" n7 i0 }8 ^, A    Dim j As Integer
    For i = 0 To 21
2 }9 z5 ?: u8 Y) e+ V# Y  k! r    For j = 0 To 21
    ' 预先指定一个被投影面
    Dim mySelMgr As SldWorks.SelectionMgr
    Dim selObj As Object
2 ~8 m' S8 Q) ?; x7 Y    Dim faceToUse As SldWorks.Face2
5 G3 [" I" W) R, d    Dim surfaceToUse As SldWorks.Surface
1 T" ^2 n2 p6 \& S4 [) N    Dim selCount As Long
    Dim selType As Long
$ j, c% r* N+ R3 }" k    Set mySelMgr = myModel.SelectionManager
        selCount = mySelMgr.GetSelectedObjectCount2(0)
& n" {, N8 Z& J" y; E6 A/ R, _        If (selCount > 0) Then
5 J1 R: [! D& l! w( y# f7 }1 N+ ^        selType = mySelMgr.GetSelectedObjectType3(1, 0)
    Set selObj = mySelMgr.GetSelectedObject6(1, 0)
        If (selType = SwConst.swSelFACES) Then
8 i' O2 B/ I- A- r% s        Set faceToUse = selObj
        End If
    End If
    ' 定义投影向量
$ H) ^1 a( R" e9 R" V; L( [  ]    Dim basePoint(0 To 2) As Double, rayDir(0 To 2) As Double
    Dim vBasePoint As Variant, vVector As Variant
    Dim rayPoint As SldWorks.MathPoint, rayVector As SldWorks.MathVector
9 i9 E/ {$ p/ x/ R, [) g6 g    Dim intersectPt As SldWorks.MathPoint
; G1 I, |; b4 G- h    Dim vPoint As Variant, vPoint2 As Variant
    Dim xPt As Double, yPt As Double, zPt As Double
' Z; z2 j& c# D% a# x, G* p    ' 先对曲面的情况进行投影； First try the face
2 s" t: F4 }( a% a2 L: J' v$ K. f        If Not faceToUse Is Nothing Then
2 |/ Y* E( r* @% P        basePoint(0) = i * 0.125 '
! E) R% I+ s/ J+ ^7 i) o% Z        basePoint(1) = j * 0.125 '
$ k( _: x3 p. D" L/ U) n        basePoint(2) = 1#
" L2 U7 a; k5 \7 ^. ^        vBasePoint = basePoint
    Set rayPoint = mathUtils.CreatePoint(vBasePoint)
        rayDir(0) = 0#
; {% f0 z: g/ k) e+ O, r        rayDir(1) = 0#
        rayDir(2) = -1#
        vVector = rayDir
4 E' n1 i$ ?3 @& s! K    Set rayVector = mathUtils.CreateVector(vVector)
( V4 l- e: `; L) A) O; N( W    Set intersectPt = faceToUse.GetProjectedPointOn(rayPoint, rayVector)
) V: b  b8 Y' a% O/ i4 x1 L+ P  w    If Not intersectPt Is Nothing Then
) M  c% Y* ^+ q. z/ @$ p1 d        vPoint = intersectPt.ArrayData
' @5 ^5 P7 ^9 l0 n        xPt = vPoint(0)
2 Y9 C5 A( E7 ^% m        yPt = vPoint(1)
7 L9 E* H& w( p9 b        zPt = vPoint(2)
+ B3 e* u3 \: X+ s        清单输出窗口.LIST.Text = 清单输出窗口.LIST.Text & Format(xPt * 1000, "##0.0#####") & " ,"
7 f+ h7 p) m; v5 F, S, w
        清单输出窗口.LIST.Text = 清单输出窗口.LIST.Text & Format(yPt * 1000, "##0.0#####") & " ,"

        清单输出窗口.LIST.Text = 清单输出窗口.LIST.Text & Format(zPt * 1000, "##0.0#####") & " " & vbCrLf
8 A9 y4 D" k  n3 a+ I    Else
        清单输出窗口.LIST.Text = 清单输出窗口.LIST.Text & Format(zPt * 1000, "##0.0#####") & " " & vbCrLf    '(j * 125, "##0.0#####") & " , 0" & "   " & vbCrLf '控制是否输出未投影到曲面上的点位 " No face hit point."
5 x6 S9 c1 w' ^5 C      End If
4 I( k5 M! J6 N. G8 ~% X    End If
  t! N( Y4 b3 h$ D3 P6 w8 k    Next j
    Next i

    清单输出窗口.计算耗用时间.Text = Round(Timer) - Round(nStart) & "秒"
    清单输出窗口.Show
End Sub

Public Sub Delayms(lngTime As Long) '延时程序调用-测试时用
Dim StartTime As Single
Dim CostTime As Single
  O" k+ b2 ^: Q9 TStartTime = Timer
2 d( ]( N5 }4 k- Y$ u5 sDo While (Timer - StartTime) * 1000 < lngTime
2 L% C- p2 b; e5 b1 ^2 c0 CDoEvents
: D# ?% w) r/ m% W, _, ]+ k# |Loop
Set swApp = Application.SldWorks
8 a8 i+ D% b' g" ]  Z. ]% E( OEnd Sub




% }8 U' j7 @' I, w. E9 n

喂我袋盐

支持

刘大官人

盲区

吴嗒嗒

牛逼，这是什么东西？你们这时solidwork直接对接生产吗？