|
楼主 |
发表于 2009-1-14 15:37
|
显示全部楼层
Set ma = c.MergeArea
2 Q: i$ m7 q+ }) q8 c4 O‘求出单元格C的合并单元格地址
' u1 }- {1 k; z8 aIf Left(Trim(ma.Address), 4) = Trim(c.Address) Then
& u* t/ r* U, G5 S% c假如c.mergearea的绝对地址,如果前4个字符与c单元格的地址相同; K) K. }. g" G) o6 S" X
xl = "A1:" + ma.Address( l' }" ~, q! l: w$ k: Y% _
xh = xlsheet.Range(ma.Address).Width 0 a0 u) U) [: M7 x) S
yh = xlsheet.Range(ma.Address).Height 8 \2 W% I7 t7 _ Y. v
Set xlrange = xlsheet.Range(xl)
! S( X, _. j4 u3 a( Ixinsert = xlrange.Width - xh+ ]: U1 a, \7 P/ R" H% V$ r3 [
yinsert = xlrange.Height - yh5 }) X: c- U1 x. ?2 c
xpoint = xinit + xinsert- I, `" `2 A" c* W, r5 O
ypoint = yinit - yinsert
( L E# z, [+ H6 P1 AIf x = 1 Then
& t1 ? i# V- TIf ma.Borders(xlEdgeTop).LineStyle
: r' z. {0 y4 n<> xlNone Then+ I/ k6 N5 _" x; s
ptArray(0) = xpoint
! q7 f2 a% J+ x‘第一点坐标(数组下标 0 and 1)3 o/ @ [! p. x. t/ D6 B, A
ptArray(1) = ypoint
3 z4 f! i7 c1 U: v- QptArray(2) = xpoint + xh $ \5 [$ ? g+ b( @8 y x3 Y
‘第二点坐标(数组下标 2 and 3)( x" b T/ n7 A, y4 ~
ptArray(3) = ypoint
0 e4 y1 _3 j* hEnd If * [5 ]) \' f" o8 v, w4 A
' ]/ {/ d; w- GLineweight lwployobj, ma.Borders(xlEdgeTop).Weight
) l# B2 q0 f4 ^* B X1 c4 \1 \# q7 mEnd If / I3 F6 K0 q& B5 b
If ma.Borders(xlEdgeBottom).LineStyle [; ` e3 Z' O" A! F
< > xlNone Then
3 `* s( T6 q$ f3 V" dptArray(0) = xpoint + xh 4 R7 e. m. _8 `
‘第三点坐标(数组下标 0 and 1)
; @9 U! v% t% a% U0 J! \9 F% tptArray(1) = ypoint - yh
F7 i3 w& i( t' B( s4 CptArray(2) = xpoint
3 a( M/ {% T, k t' H7 r‘第四点坐标(数组下标 2 and 3)
( I0 b7 V1 i8 v! S8 U optArray(3) = ypoint – yh% c5 n: n- I0 F( A
Lineweight lwployobj,( A" [9 N$ n9 x, ^
ma.Borders(xlEdgeBottom).Weight
8 N* ~9 j4 Z# _' z) \- a; MEnd If
$ q L, _, N6 H. TIf y = 1 Then5 e7 `5 ~$ |# t# P, I4 V1 K
If ma.Borders(xlEdgeLeft).LineStyle
! P, N0 i- O6 R- p3 r& X< > xlNone Then* I ]% c1 u2 ~: k; p7 e
ptArray(0) = xpoint . {' O! f1 B, F$ M* c
‘第四点坐标(数组下标 0 and 1)3 Q) N4 P: y" Y+ [) H
ptArray(1) = ypoint - yh' W+ T/ S4 }7 ]( k* c; y2 l
ptArray(2) = xpoint + G/ _3 R. I7 i" O% C
‘第一点坐标(数组下标 2 and 3)8 `( B& j+ A% r1 O- Z
ptArray(3) = ypoint& d9 b3 h {5 Y& @6 ~
End If
1 n* u$ [: v* L. HLineweight lwployobj, ma.Borders(xlEdgeLeft).Weight
- D1 ~: `; f6 pEnd If : _, m4 S, n+ R# z+ a3 ]+ y
If ma.Borders(xlEdgeRight).LineStyle6 {4 ~! F- F* ^ }4 a, c( h* B
< > xlNone Then; e( d% U3 z; n1 W5 g
ptArray(0) = xpoint + xh
& R6 o: @3 o) V- S( m$ T‘第二点坐标(数组下标 0 and 1): ]: f' b0 U+ k& `0 z l( m* `
ptArray(1) = ypoint% r7 y4 _& ^" O
ptArray(2) = xpoint + xh
, Q5 R h; X; \1 i/ G‘第三点坐标(数组下标 2 and 3)
5 D3 D9 i) c, FptArray(3) = ypoint – yh0 E0 n) ~* x5 b
Lineweight lwployobj,
6 C! w* Z( h3 c' {' ?/ z; t+ Q7 @ma.Borders(xlEdgeRight).Weight
0 @4 Y. W# S; L9 K7 L- q* tEnd If G( j1 [* ~" [8 Y
Set lwployobj = moSpace.AddLightWeightPolyline(ptArray)
7 e/ ]6 S+ |' B- _‘在AutoCAD文件里画线
! G. z$ X6 T0 WWith lwployobj
5 U' l' T/ p) D1 n4 t' [.Layer = newlayer.name ‘指定lwployobj所在图层
, Q8 l' F6 [+ f# s.Color = acBlue ‘指定lwployobj的颜色
1 T$ y, o# ^! u# U5 H" e zEnd With 8 R# O% Q, a: c( ]4 ^! K; Q6 ?
Lwployobj.Update
3 P7 A* b9 S NNext y
# O. H5 e5 U% l6 z R* CNext x3 D+ f1 ?1 N8 o9 R4 A, s
End Sub: {# }# x- C" N. i: V" n( i' O
‘下面程序控制线条粗细" q8 H. k _# c# n9 G* w
Sub Lineweight(ByVal line As Object, u As Integer)0 U4 e3 S- {* F. D5 l9 m0 ]
Select Case u/ _6 i+ z0 v9 ` K* O7 ~ R
Case 11 t: I% r4 ?5 z% o
Call line.SetWidth(0, 0.1, 0.1)& a: j6 w& R; r2 _
Case 2( T* M, H# R3 f& w3 A! W
Call line.SetWidth(0, 0.3, 0.3)
@* L" \3 I4 P; Y6 s" qCase -4138
+ t% V' _7 b' ~6 j! J; A1 yCall line.SetWidth(0, 0.5, 0.5) |
|