|
|
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
|
|
置顶卡
