《CADVBA]计算板材重量》由会员分享，可在线阅读，更多相关《CADVBA]计算板材重量（13页珍藏版）》请在金锄头文库上搜索。
1、原创-CAD/VBA计算板材重量Public Sub PlateKg() 计算板材重量+ Code By icy/忽又一天 + Email: + Q Q: 365052003 + Blog: Http:/ + On Error Resume Next Dim Pnt As Variant Dim strPnt As String Dim i As Integer, J As Integer Dim ObjArea As Double, tmpAreas() As Double, objlength As Double, tmplengths() As Double, PlateWeight
2、As Double Dim txtObj As AcadEntity Dim BoundaryObj As Variant Dim CurScale As Double CurScale = GetVariable(DIMSCALE) Dim PriCount As Long Dim ObjType As Integer ObjType = ThisDrawing.GetVariable(HPBOUND) Dim CurLayer As String Dim CurColor As String CurColor = ThisDrawing.GetVariable(CECOLOR) Dim A
3、reaLayer As AcadLayer Set AreaLayer = ThisDrawing.Layers.Add(Wee_Area) AreaLayer.color = 11 ThisDrawing.ActiveLayer = AreaLayer Dim CurSnapMode As Integer CurSnapMode = ThisDrawing.GetVariable(OSMODE) ThisDrawing.ObjectSnapMode = False ThisDrawing.SetVariable CECOLOR, BYLAYER Dim pThickness As Strin
4、g pThickness = ThisDrawing.Utility.GetString(0, vbCrLf & 输入板材厚度(mm)：) If Err.Number 0 Then Err.Clear GoTo ErrorHandler End If If Val(pThickness) = 0 Then pThickness = 14 Else pThickness = Val(pThickness) End If Dim Mdensity As String Mdensity = ThisDrawing.Utility.GetString(0, vbCrLf & 输入材料密度(x103 k
5、g/m3)：) If Err.Number 0 Then Err.Clear GoTo ErrorHandler End If If Val(Mdensity) = 0 Then Mdensity = 7.85 Else Mdensity = Val(Mdensity) End If Dim ifIsland As String ifIsland = ThisDrawing.Utility.GetString(0, vbCrLf & 是否除去内部孤岛 Yes/No：) If Err.Number 0 Then Err.Clear GoTo ErrorHandler End If If UCas
6、e(ifIsland) = NO Or UCase(ifIsland) = N Then ifIsland = 0 Else ifIsland = 1 End If Dim objName As String Dim objLayer As String Dim PreCount As Long, CurCount As Long Do While True ObjArea = 0 PlateWeight = 0 Pnt = ThisDrawing.Utility.GetPoint(, vbCrLf & 拾取对象内部一点：) If Err.Number 0 Then Err.Clear GoT
7、o ErrorHandler End If ReDim Preserve Pnt(0 To 2) As Double strPnt = Pnt(0) & , & Pnt(1) With ThisDrawing PreCount = ModelSpace.Count ThisDrawing.SetVariable HPBOUND, 0 SendCommand Chr(3) & Chr(3) & -boundary & strPnt & & If PreCount = ModelSpace.Count Then ThisDrawing.SetVariable HPBOUND, 1 SendComm
8、and Chr(3) & Chr(3) & -boundary & strPnt & & End If CurCount = ModelSpace.Count Select Case CurCount - PreCount Case Is 1 ReDim tmpAreas(0 To CurCount - PreCount - 1) As Double ReDim tmplengths(0 To CurCount - PreCount - 1) As Double For i = 0 To CurCount - PreCount - 1 Set BoundaryObj = ModelSpace.
9、Item(PreCount + i) If (BoundaryObj.ObjectName = AcDbRegion) Or (BoundaryObj.ObjectName = AcDbPolyline) And (BoundaryObj.Layer = Wee_Area) Then tmpAreas(i) = BoundaryObj.Area tmplengths(i) = BoundaryObj.Perimeter MsgBox 周长 & i & : & tmplengths(i) End If Next NumSortAZ tmpAreas, 0, UBound(tmpAreas) Nu
10、mSortAZ tmplengths, 0, UBound(tmplengths) ObjArea = tmpAreas(UBound(tmpAreas) objlength = tmplengths(UBound(tmplengths) If CBool(ifIsland) Then For i = 0 To UBound(tmpAreas) - 1 ObjArea = ObjArea - tmpAreas(i) Next For i = 0 To UBound(tmplengths) - 1 objlength = objlength + tmplengths(i) Next End If Case Is 0 Then PlateWeight = ObjArea * CDbl(pThickness) * CDbl(Mdensity) / 1000000 Utility.Prompt vbCrLf & 有效面积： & Form
