- 积分
- 5987
- 明经币
- 个
- 注册时间
- 2006-7-8
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
Sub MaterialTitle() Dim cadApp As AcadApplication Set cadApp = ConnectCad Dim xArr, textTitle, heightTitle, materialRow xArr = Array(0, 20, 50, 97, 107, 137, 148.5, 160, 171.5, 180) textitle = Array("件 号", "图号或标准号", "名 称", "数量", "材 料", "单", "总", "质 量(kg)", "备 注") Dim pp0(2) As Double, pp1(2) As Double materialRow = 13 'heightTitle = 14 + 8 * materialRow pp1(0) = 180 With cadApp.ActiveDocument.ModelSpace For ii = 0 To materialRow + 2 If ii = 0 Then heightTitle = 0 ElseIf ii = 1 Then heightTitle = 14 Else heightTitle = heightTitle + 8 End If pp0(1) = heightTitle: pp1(1) = pp0(1) Set objLine = .AddLine(pp0, pp1) Next ii '' Dim p0(2) As Double, p1(2) As Double p0(1) = 0: p1(1) = heightTitle For jj = 0 To UBound(xArr) p0(0) = xArr(jj): p1(0) = p0(0) Set objLine = .AddLine(p0, p1) Next jj End With End Sub
|
|