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

jjww123

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

- ^& p+ m$ E/ U$ C6 Q6 C/ Z非常感谢！

jjww123

继续求助。。。请版主就下面的代码。。帮我标注下这个长方体
* K# w/ T5 _% A0 x7 h* W8 s$ f
center1(0) = 1: center1(1) = 1: center1(2) = 1
3 p6 v. ^# s0 A0 B5 E- k length = 2: width = 2: height = 4
Set boxobj1 = ThisDrawing.ModelSpace.AddBox(center1, length, width, height)
' Q, ]+ ]( c: p; W
麻烦帮帮忙~~谢谢！

woaishuijia

1. 
   2 }$ G8 z) N4 j$ W7 h( l) Z
2. Dim Center1(2) As Double, Length As Double, Width As Double, Height As Double, Boxobj1 As Acad3DSolid
   
3. Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, Ucs As AcadUCS
   ) |$ |, ]+ p  t) d
4. With ThisDrawing
   ; ?* e: y9 s' P% B" _
5.     Center1(0) = 1: Center1(1) = 1: Center1(2) = 1
   
6.     Length = 2: Width = 2: Height = 4
   & f. H" q6 r5 K5 O9 T6 J' \
7.     Set Boxobj1 = .ModelSpace.AddBox(Center1, Length, Width, Height)
   
8.    
   ' Y/ E( O$ i) C6 D5 ?6 b/ R5 a
9.     P1(0) = Center1(0): P1(1) = Center1(1): P1(2) = Center1(2) + Height / 2 '新UCS原点
   
10.     P2(0) = P1(0) + 1: P2(1) = P1(1): P2(2) = P1(2) '新UCS的X方向,与WCS的X方向相同
    ) O8 W$ N3 ]1 c% c4 i* k$ @8 z" X
11.     P3(0) = P1(0): P3(1) = P1(1) + 1: P3(2) = P1(2) '新UCS的Y方向,与WCS的Y方向相同
    0 i! w& T, E# E" n
12.     Set Ucs = .UserCoordinateSystems.Add(P1, P2, P3, "U") '新建UCS
    . v; @3 `) p' N
13.     .ActiveUCS = Ucs  '新UCS置为当前
    
14.    
    - V( M9 r& C" y" D
15.     SendCommand "dimlinear  0," & -Width / 2 & " 0," & -Width / 2 - 1 & " "
    
16.     SendCommand "dimlinear  " & -Length / 2 & ",0 " & -Length / 2 - 1 & ",0 "
    . x7 Z9 w- L1 z2 B8 D
17. 
      f8 s+ L* x+ O  M. f
18.     P1(0) = Center1(0): P1(1) = Center1(1) - Width / 2: P1(2) = Center1(2) '新UCS原点
    ; \% J. P, l$ e! A9 f' V2 K7 E
19.     P2(0) = P1(0) + 1: P2(1) = P1(1): P2(2) = P1(2) '新UCS的X方向,与WCS的X方向相同
      j+ i2 E! L# A: g1 ^4 v
20.     P3(0) = P1(0): P3(1) = P1(1): P3(2) = P1(2) + 1 '新UCS的Y方向,与WCS的Z方向相同
    8 m% n/ L( g: C. I* s. F6 ~4 u
21.     Set Ucs = .UserCoordinateSystems.Add(P1, P2, P3, "U") '新建UCS
    
22.     .ActiveUCS = Ucs  '新UCS置为当前
    
23.    
    4 _/ R# @: d7 |0 ~  W' S& A
24.     SendCommand "dimlinear  " & -Length / 2 & ",0 " & -Length / 2 - 1 & ",0 "
    
25.    
    
26.     SendCommand "ucs w " '恢复WCS
    
27. End With
    9 C! s3 d/ w! {# z" v+ j9 \

复制代码