机械社区
标题:
SW关于输出曲面点阵到txt文档的宏代码
[打印本页]
作者:
oy87188
时间:
2023-11-4 18:14
标题:
SW关于输出曲面点阵到txt文档的宏代码
本帖最后由 oy87188 于 2023-11-4 18:45 编辑
+ E$ i) [4 l. t
1 a. ~# P3 x( l1 H Y9 }, r
尊敬的各位大佬，本人是SW使用的小白，最近在调试SW的宏代码时，想通过宏代码将曲面上的点阵输出到txt中，从而方便后续处理。但是遇到了如下的问题：显示对应变量未定义，还望各位大佬多多指点一二？
% @ P1 d7 f8 l; E4 P& i4 f4 j
附上对应的代码如下：（压缩包内为swp文件）
j( Y3 b! c- u5 g) y' Q
/ ]& C; Z/ G: y2 P& j/ m* ?
! `% @3 y! {$ E, e* o6 b
* S6 D# M1 l# W5 [2 l K
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4 f. b! N" N! h! s% {
' 输出曲面上某些点到Txt文件中
4 F& {) V) D. A. A' B2 ^
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
0 O" d* f3 Z+ o% \. A G+ C
Sub main()
5 `2 F6 l2 r/ [, V4 P6 T# v
Dim swApp As SldWorks.SldWorks
' c( a& x4 F( F
Dim myModel As SldWorks.ModelDoc2
! M( N( w6 S; h4 J( \3 P
Dim mathUtils As SldWorks.MathUtility
! K& Z% x9 d; U! q/ c
Dim nStart As Single
" L: R0 l, B$ W* H% M# j- S: j
nStart = Timer
2 ?+ @6 N( }( J" q e
Set swApp = Application.SldWorks
# j% d1 r/ c' r `, I
Set myModel = swApp.ActiveDoc
1 |6 I4 o* |! K" y7 {$ k' H
Set mathUtils = swApp.GetMathUtility()
2 x* t& j' w2 h9 z/ s
' 以下遍历22x22个投影点
" G+ e/ _6 ~. q. k* G4 I) C8 M
Dim i As Integer
% Z' c: M/ [. J
Dim j As Integer
) |) c/ ?6 b, S
For i = 0 To 21
: z% l5 k7 F* {3 E5 e6 T/ A
For j = 0 To 21
! L* @% s! f. T6 H" M! F
' 预先指定一个被投影面
$ d: o/ l# |: R9 Z) }. S
Dim mySelMgr As SldWorks.SelectionMgr
7 V% q2 V' E! h5 k$ c1 B+ w
Dim selObj As Object
$ x4 j! f( k5 Y+ m( m
Dim faceToUse As SldWorks.Face2
3 J, J1 t5 K( [8 M( O# W1 |2 w" j2 }
Dim surfaceToUse As SldWorks.Surface
; X5 @( ?8 M* ^' f/ H; D& r; g
Dim selCount As Long
1 y5 K# H/ C e9 W3 T
Dim selType As Long
& d, k4 M) \* T
Set mySelMgr = myModel.SelectionManager
" g& [, J9 B/ _
selCount = mySelMgr.GetSelectedObjectCount2(0)
6 |/ Y1 f$ N& J1 u8 B
If (selCount > 0) Then
+ z. l3 Q, E( g9 i3 G( A
selType = mySelMgr.GetSelectedObjectType3(1, 0)
, \; y& Y9 y; F: R* f: b
Set selObj = mySelMgr.GetSelectedObject6(1, 0)
7 M2 ]: U9 [- y( b& d. g8 |# u9 ^
If (selType = SwConst.swSelFACES) Then
2 h) S# i7 Q$ k5 p6 d
Set faceToUse = selObj
7 [) { ^& U' a3 Z B1 E: s }
End If
* h$ p5 t, w& ~! e8 l n
End If
- z9 x4 v' n9 t( s$ n
' 定义投影向量
( X" u1 r$ {& U7 p' D
Dim basePoint(0 To 2) As Double, rayDir(0 To 2) As Double
4 Q; k, \9 y% |2 E2 p$ r+ o
Dim vBasePoint As Variant, vVector As Variant
; Y; s, G6 o% m8 g( R7 A
Dim rayPoint As SldWorks.MathPoint, rayVector As SldWorks.MathVector
4 U( v9 O$ Z' s7 y
Dim intersectPt As SldWorks.MathPoint
) x6 Y3 B3 w ?4 ?: J
Dim vPoint As Variant, vPoint2 As Variant
, y6 [( _7 y, i/ C6 b) N
Dim xPt As Double, yPt As Double, zPt As Double
1 H( V. E0 C: g$ M
' 先对曲面的情况进行投影； First try the face
5 Y+ \, B5 u+ H; n. ?3 F" k
If Not faceToUse Is Nothing Then
s/ ]9 Q; o; W, K% ~
basePoint(0) = i * 0.125 '
6 O$ z( X4 h$ F5 g2 Z
basePoint(1) = j * 0.125 '
$ d, m/ {! M, v4 C+ I
basePoint(2) = 1#
A8 v6 G4 a& K6 {
vBasePoint = basePoint
# M% ], \! E% h- @! D& s
Set rayPoint = mathUtils.CreatePoint(vBasePoint)
' x& k, h F8 M8 ^/ x& J
rayDir(0) = 0#
$ d. r' q* |" G6 `& \- a; @/ X) X
rayDir(1) = 0#
3 t9 {* q0 }0 v/ K% l
rayDir(2) = -1#
) ~1 X; t* V! I- D9 h
vVector = rayDir
4 ]" s D( {4 n$ o# R
Set rayVector = mathUtils.CreateVector(vVector)
. c y6 c2 R+ w* G$ z6 ?; ]
Set intersectPt = faceToUse.GetProjectedPointOn(rayPoint, rayVector)
. ^, K: _. H/ b S0 W+ M
If Not intersectPt Is Nothing Then
9 o$ |" U+ T# G9 T+ x
vPoint = intersectPt.ArrayData
& ]9 P/ N3 Q) I; N
xPt = vPoint(0)
1 E1 \& K' J6 n; S# X8 g! V
yPt = vPoint(1)
: C& |% V) r5 {; J
zPt = vPoint(2)
* _! N8 {, |2 C) u1 X- q
清单输出窗口.LIST.Text = 清单输出窗口.LIST.Text & Format(xPt * 1000, "##0.0#####") & " ,"
0 b" Q0 L% |( J
a1 g* E" C# X5 F; e! c$ X
清单输出窗口.LIST.Text = 清单输出窗口.LIST.Text & Format(yPt * 1000, "##0.0#####") & " ,"
, `+ E" G% W/ O9 R6 k- D7 n
" p0 M& F4 V2 O0 r
清单输出窗口.LIST.Text = 清单输出窗口.LIST.Text & Format(zPt * 1000, "##0.0#####") & " " & vbCrLf
8 \/ R* v7 e M: }
Else
/ R0 ^. o9 z* ^! S
清单输出窗口.LIST.Text = 清单输出窗口.LIST.Text & Format(zPt * 1000, "##0.0#####") & " " & vbCrLf '(j * 125, "##0.0#####") & " , 0" & " " & vbCrLf '控制是否输出未投影到曲面上的点位 " No face hit point."
2 \8 H* f1 `, i# C9 @1 a9 X2 r4 z
End If
' t0 @- Y% l* M; G1 _
End If
3 ^1 [3 c, b& p$ O& W; D9 ^2 k
Next j
5 H- }9 k. `" T+ j! g- M% V
Next i
1 @+ D3 V1 M% e; c. V; n
9 z6 L; {. w- d! @4 X
清单输出窗口.计算耗用时间.Text = Round(Timer) - Round(nStart) & "秒"
8 I9 {+ [0 A1 \, O
清单输出窗口.Show
# g+ ^4 L# d7 @+ U- X3 r" M3 r/ z' ?
End Sub
& S- C4 Y& s* P/ N; M
3 k. I+ I' P* n6 s" B* t1 u7 T
Public Sub Delayms(lngTime As Long) '延时程序调用-测试时用
( N, X+ l6 w4 l" Q) E0 O! |) v
Dim StartTime As Single
- [& M, r- b8 @, l5 C
Dim CostTime As Single
) S% E8 N( Y- m% p) q
StartTime = Timer
' u6 W+ ` o" V% v
Do While (Timer - StartTime) * 1000 < lngTime
, }9 f x$ s2 _. Y" @5 ~* ~4 {
DoEvents
+ [9 J: U3 e, T8 ?! \& |
Loop
$ I$ s+ ?* s" Z# h2 G% x
Set swApp = Application.SldWorks
' ^* w8 g3 C/ R
End Sub
3 ?9 Q0 g. c3 c; |
- k0 R3 m( P; F) Y/ T9 w0 u9 x* ]/ k5 F
& D) Y* y4 n7 J: j& z3 z) o
# G" a& V- P5 l5 S2 S% A
9 w1 s! i, }5 h4 t% d
作者:
喂我袋盐
时间:
2023-11-4 20:05
支持
作者:
刘大官人
时间:
2023-11-5 08:20
盲区
作者:
吴嗒嗒
时间:
2023-11-5 16:57
牛逼，这是什么东西？你们这时solidwork直接对接生产吗？
欢迎光临 机械社区 (http://www.cmiw.cn/)
Powered by Discuz! X3.4
