'平法梁配筋率分析
Sub GetLPJL()
    Dim ssText As AcadSelectionSet          '选择集
    Dim acText As AcadText                  '选择集中的文本
    
    Dim Txt As String '文本的字符串
    
    Dim X As Integer '字符串中是否含有乘号
    Dim Temp As Integer
    Dim Temp1 As Integer
    Dim Temp2 As String
    Dim Temp3 As String
    Dim Temp4 As String
    Dim LK As Integer
    Dim LG As Integer
    Dim AT As Long
    Dim AB As Long
    Dim LH As String
    
    Dim i As Integer
    Dim j As Integer
    
    
    On Error Resume Next
    
    Set ssText = ThisDrawing.SelectionSets.Add("Text")
    '定义过滤机制
    Dim filterType(0) As Integer
    Dim filterData(0) As Variant
    filterType(0) = 0
    filterData(0) = "TEXT"
    '提示用户在屏幕上选择文字
    ssText.SelectOnScreen filterType, filterData
    N = ssText.Count - 1
    For i = 0 To N
        Set acText = ssText.item(i)
        Txt = acText.textString
        X = InStr(Txt, "x") '标志他是平法标注的第一行
        Temp2 = Left(Txt, 1)
        'MsgBox X
        If X > 0 Then
           Temp = InStr(Txt, "(")
           Temp1 = InStr(Txt, ")")
           LH = Left(Txt, Temp - 1)
           LK = Val(Mid(Txt, Temp1 + 1, X - Temp1))
           'MsgBox "梁宽" & LK
           LG = Val(Mid(Txt, X + 1))
           'MsgBox "梁高" & LG '
        End If
        '平法标注中只会存在一行第一个字符串是数字的。
        If IsNumeric(Temp2) Then
                Temp = InStr(Txt, ";")
                If Temp > 0 And j = 0 Then '假如存在分号且为第一个，把他的上部和下部钢筋全部分析出来
                    Temp3 = Left(Txt, Temp - 1)
                    Temp4 = Mid(Txt, Temp + 1)
                    AT = GetSteels2(Temp3)
                    AB = GetSteels2(Temp4)
                ElseIf Temp = 0 And j = 0 Then '没有分号，且为第一个，肯定是上部钢筋
                    AT = GetSteels2(Txt)
                ElseIf Temp = 0 And j = 1 Then '没有分号，且是第二个，肯定是下部钢筋
                    AB = GetSteels2(Txt)
                ElseIf Temp >= 0 And j = 1 Then '有分号其是第二个，只用分析其下部钢筋。
                    Temp3 = Left(Txt, Temp - 1)
                    Temp4 = Mid(Txt, Temp + 1)
                    AB = GetSteels2(Temp4)
                End If
                j = j + 1
        End If
    Next i
    'MsgBox "上部钢筋面积" & AT
    'MsgBox "上部钢筋配筋率" & Format(AT / LK / LG * 100, "0.0000")
    'MsgBox "下部钢筋面积" & AB
    'MsgBox "下部钢筋配筋率" & Format(AB / LK / LG * 100, "0.0000")
    'MsgBox "上下钢筋面积比" & Format(AT / AB, "0.00")
    Dim P As Variant
    P = ThisDrawing.Utility.GetPoint(, "文字插入点")
    Dim S(5) As String
    S(0) = LH '梁编号
    S(1) = "上部钢筋面积" & AT
    S(2) = "上部钢筋配筋率" & Format(AT / LK / LG * 100, "0.0000")
    S(3) = "下部钢筋面积" & AB
    S(4) = "下部钢筋配筋率" & Format(AB / LK / LG * 100, "0.0000")
    S(5) = "上下钢筋面积比" & Format(AT / AB, "0.00")
    AddTexts S, P, 300
        '删除选择集
    ThisDrawing.SelectionSets.item("Text").Delete
End Sub

'快速打印
Function KSDY2(P1 As Variant, P2 As Variant)


    Dim PtMin As Variant
    Dim PtMax As Variant
    PtMin = P1
    PtMax = P2
    
    ReDim Preserve PtMin(0 To 1)
    ReDim Preserve PtMax(0 To 1)
    
    
    
    ' 设置打印比例为“布满图纸”
    ThisDrawing.ActiveLayout.StandardScale = acScaleToFit
    
    ThisDrawing.ActiveLayout.SetWindowToPlot PtMin, PtMax
    ' 设置打印类型为窗口
    ThisDrawing.ActiveLayout.PlotType = acWindow
    '设置为居中打印
    ThisDrawing.ActiveLayout.CenterPlot = True

    If Me.OptionButton4.Value = True Then
        '启用打印预览
        
        ThisDrawing.ActiveLayout.GetWindowToPlot PtMin, PtMax
        
        ThisDrawing.Plot.DisplayPlotPreview acFullPreview
    Else
        '打印当前的区域
        '若选中“打印到文件”
        If PlotTofile_CheckBox.Value Then
            If PlotFilesPath_ComboBox.text = "" Then PlotFilesPath_ComboBox.text = GetPath
            ThisDrawing.Plot.PlotToFile PlotFilesPath_ComboBox.text & ThisDrawing.Name & "-" & N & ".plt"
            N = N + 1
        Else
            ThisDrawing.Plot.PlotToDevice ThisDrawing.ModelSpace.Layout.ConfigName
        End If
    End If
End Function

'输出wmf文件
Public Function WMFOut(P1 As Variant, P2 As Variant, FileName As String)
    ThisDrawing.Application.ZoomAll
    '创建空选择集
    Dim SSet As AcadSelectionSet
    Set SSet = CreateSelectionSet("XXX")

    '为选择集添加对象
    SSet.Select acSelectionSetWindow, P1, P2

    '将选择集中对象传递给Obj对象数组
    Dim Obj() As Object
    Dim i As Long
    ReDim Obj(0 To SSet.Count - 1) As Object
    For i = 0 To SSet.Count - 1
        Set Obj(i) = SSet.Item(i)
    Next i
    
    Dim X As Double
    Dim Y As Double
    X = Abs(P1(0) - P2(0)) '图形宽度
    Y = Abs(P1(1) - P2(1)) '图形高度
    
    Dim Xy As Double
    
    Xy = X / Y '图形宽高比
    
    X = 600 '文档视口宽度
    
    Y = 600 / Xy '文档视口高度
    
    ThisDrawing.Width = X
    ThisDrawing.Height = Y
    
    ThisDrawing.Application.ZoomWindow P1, P2
    
    '导出wmf文件
    If UCase(Right(FileName, 4)) = ".WMF" Then
       FileName = Left(FileName, Len(FileName) - 4)
    End If
    ThisDrawing.Export FileName, "WMF", SSet
End Function