SW关于输出曲面点阵到txt文档的宏代码
本帖最后由 oy87188 于 2023-11-4 18:45 编辑尊敬的各位大佬，本人是SW使用的小白，最近在调试SW的宏代码时，想通过宏代码将曲面上的点阵输出到txt中，从而方便后续处理。但是遇到了如下的问题：显示对应变量未定义，还望各位大佬多多指点一二？:lol:lol
附上对应的代码如下：（压缩包内为swp文件）
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' 输出曲面上某些点到Txt文件中
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub main()
Dim swApp As SldWorks.SldWorks
Dim myModel As SldWorks.ModelDoc2
Dim mathUtils As SldWorks.MathUtility
Dim nStart As Single
nStart = Timer
Set swApp = Application.SldWorks
Set myModel = swApp.ActiveDoc
Set mathUtils = swApp.GetMathUtility()
' 以下遍历22x22个投影点
Dim i As Integer
Dim j As Integer
For i = 0 To 21
For j = 0 To 21
' 预先指定一个被投影面
Dim mySelMgr As SldWorks.SelectionMgr
Dim selObj As Object
Dim faceToUse As SldWorks.Face2
Dim surfaceToUse As SldWorks.Surface
Dim selCount As Long
Dim selType As Long
Set mySelMgr = myModel.SelectionManager
selCount = mySelMgr.GetSelectedObjectCount2(0)
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
Dim rayPoint As SldWorks.MathPoint, rayVector As SldWorks.MathVector
Dim intersectPt As SldWorks.MathPoint
Dim vPoint As Variant, vPoint2 As Variant
Dim xPt As Double, yPt As Double, zPt As Double
' 先对曲面的情况进行投影； First try the face
If Not faceToUse Is Nothing Then
basePoint(0) = i * 0.125 '
basePoint(1) = j * 0.125 '
basePoint(2) = 1#
vBasePoint = basePoint
Set rayPoint = mathUtils.CreatePoint(vBasePoint)
rayDir(0) = 0#
rayDir(1) = 0#
rayDir(2) = -1#
vVector = rayDir
Set rayVector = mathUtils.CreateVector(vVector)
Set intersectPt = faceToUse.GetProjectedPointOn(rayPoint, rayVector)
If Not intersectPt Is Nothing Then
vPoint = intersectPt.ArrayData
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#####") & " ,"
清单输出窗口.LIST.Text = 清单输出窗口.LIST.Text & Format(zPt * 1000, "##0.0#####") & " " & vbCrLf
Else
清单输出窗口.LIST.Text = 清单输出窗口.LIST.Text & Format(zPt * 1000, "##0.0#####") & " " & vbCrLf '(j * 125, "##0.0#####") & " , 0" & " " & vbCrLf '控制是否输出未投影到曲面上的点位 " No face hit point."
End If
End If
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
StartTime = Timer
Do While (Timer - StartTime) * 1000 < lngTime
DoEvents
Loop
Set swApp = Application.SldWorks
End Sub
支持 盲区 牛逼，这是什么东西？你们这时solidwork直接对接生产吗？
页:
[1]