如何用VBA标注一个三维长方体尺寸？

jjww123 · 发表于 2009-3-11 16:04:54

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

请版主举一个例子。。。给我参考下。。

非常感谢！

jjww123 · 发表于 2009-4-13 11:32:54

继续求助。。。请版主就下面的代码。。帮我标注下这个长方体

center1(0) = 1: center1(1) = 1: center1(2) = 1
length = 2: width = 2: height = 4
Set boxobj1 = ThisDrawing.ModelSpace.AddBox(center1, length, width, height)

麻烦帮帮忙~~谢谢！

woaishuijia · 发表于 2009-4-15 19:13:08

; E! _3 C8 i0 b9 s# ~
Dim Center1(2) As Double, Length As Double, Width As Double, Height As Double, Boxobj1 As Acad3DSolid
4 T* j' R, {5 `8 D! @5 Z
Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, Ucs As AcadUCS! F# F3 e5 W7 C3 o8 X
With ThisDrawing4 X- ]* V6 ?+ ]# x' m
Center1(0) = 1: Center1(1) = 1: Center1(2) = 1# |& }& A5 x/ h% r5 G$ k
Length = 2: Width = 2: Height = 4) Z* ?/ N. B# p
Set Boxobj1 = .ModelSpace.AddBox(Center1, Length, Width, Height)
$ K: B0 N: p, c1 d' i( f; x# o% i
K5 B( `4 J p# Q
P1(0) = Center1(0): P1(1) = Center1(1): P1(2) = Center1(2) + Height / 2 '新UCS原点4 g" X' A* s. [* H5 \7 t; L6 ^, @+ j. ^
P2(0) = P1(0) + 1: P2(1) = P1(1): P2(2) = P1(2) '新UCS的X方向,与WCS的X方向相同' ]4 i) P* @( `. m' g
P3(0) = P1(0): P3(1) = P1(1) + 1: P3(2) = P1(2) '新UCS的Y方向,与WCS的Y方向相同
0 R' E5 }! ^ P5 f1 f$ [6 u# ~, X
Set Ucs = .UserCoordinateSystems.Add(P1, P2, P3, "U") '新建UCS
4 E6 @, j4 k1 T+ W! l) [5 d/ j
.ActiveUCS = Ucs '新UCS置为当前
8 W- {& V3 Q3 x' G6 l! Z
1 a6 W+ a% B# S3 s' T
SendCommand "dimlinear 0," & -Width / 2 & " 0," & -Width / 2 - 1 & " "* t N8 }1 j- e o3 m
SendCommand "dimlinear " & -Length / 2 & ",0 " & -Length / 2 - 1 & ",0 "1 Y& E7 I& l* _% U% l' Q
( G, w* ~* l. W8 S" G' ^
P1(0) = Center1(0): P1(1) = Center1(1) - Width / 2: P1(2) = Center1(2) '新UCS原点* d) U d6 s2 V" ~; ?: Z8 U! S
P2(0) = P1(0) + 1: P2(1) = P1(1): P2(2) = P1(2) '新UCS的X方向,与WCS的X方向相同
/ m: {6 b$ `* a
P3(0) = P1(0): P3(1) = P1(1): P3(2) = P1(2) + 1 '新UCS的Y方向,与WCS的Z方向相同7 K9 ^3 `" L7 {& |/ k* F
Set Ucs = .UserCoordinateSystems.Add(P1, P2, P3, "U") '新建UCS
) N1 G! S( }. R( `3 t
.ActiveUCS = Ucs '新UCS置为当前) d% n/ B( v3 M0 s
3 F1 D7 ?* D5 x) D* e: S$ P
SendCommand "dimlinear " & -Length / 2 & ",0 " & -Length / 2 - 1 & ",0 "
4 ]0 ?4 s: e+ ~% A7 O
" h' c j; w Q$ ~+ o* D
SendCommand "ucs w " '恢复WCS4 z$ a' e/ i1 N7 l4 ~( V3 C' _1 J
End With8 a+ }- T% s% \3 k! L1 \5 O

复制代码

		自动登录	找回密码
密码			注册

通知

[求助] 如何用VBA标注一个三维长方体尺寸？

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。