利用VBA编程实现从EXCEL表到AUTOCAD表转换
2006-04-03 09:48:40 来源:WEB开发网Lineweight lwployobj, ma.Borders(xlEdgeTop).Weight
End If
If ma.Borders(xlEdgeBottom).LineStyle
< > xlNone Then
ptArray(0) = xpoint + xh
‘第三点坐标(数组下标 0 and 1)
ptArray(1) = ypoint - yh
ptArray(2) = xpoint
‘第四点坐标(数组下标 2 and 3)
ptArray(3) = ypoint – yh
Lineweight lwployobj,
ma.Borders(xlEdgeBottom).Weight
End If
If y = 1 Then
If ma.Borders(xlEdgeLeft).LineStyle
< > xlNone Then
ptArray(0) = xpoint
‘第四点坐标(数组下标 0 and 1)
ptArray(1) = ypoint - yh
ptArray(2) = xpoint
‘第一点坐标(数组下标 2 and 3)
ptArray(3) = ypoint
End If
Lineweight lwployobj, ma.Borders(xlEdgeLeft).Weight
End If
If ma.Borders(xlEdgeRight).LineStyle
< > xlNone Then
ptArray(0) = xpoint + xh
‘第二点坐标(数组下标 0 and 1)
ptArray(1) = ypoint
ptArray(2) = xpoint + xh
‘第三点坐标(数组下标 2 and 3)
ptArray(3) = ypoint – yh
Lineweight lwployobj,
ma.Borders(xlEdgeRight).Weight
End If
Set lwployobj = moSpace.AddLightWeightPolyline(ptArray)
‘在AutoCAD文件里画线
With lwployobj
.Layer = newlayer.name ‘指定lwployobj所在图层
.Color = acBlue ‘指定lwployobj的颜色
End With
Lwployobj.Update
Next y
Next x
End Sub
‘下面程序控制线条粗细
Sub Lineweight(ByVal line As Object, u As Integer)
Select Case u
Case 1
Call line.SetWidth(0, 0.1, 0.1)
Case 2
Call line.SetWidth(0, 0.3, 0.3)
Case -4138
Call line.SetWidth(0, 0.5, 0.5)
Case 4
Call line.SetWidth(0, 1, 1)
Case Else
Call line.SetWidth(0, 0.1, 0.1)
End Select
End Sub
‘下面程序完成列号转换
Function zh(pp As Integer) As String
If pp < 26 Then
zh = Chr(64 + pp)
Else
zh = Chr(64 + Int(pp / 26)) + Chr(64 + pp Mod 26)
End If
End Function
更多精彩
赞助商链接