田草博客

互联网田草博客


网友交流QQ群:11740834 需注明申请加入原因

微信 公众号:ByCAD

邮箱:tiancao1001x126.com
ByCAD,微信公众号
首页 | 普通 | 电脑 | AutoCAD | VB/VB.NET | FLash | 结构 | 建筑 | 电影 | BIM | 规范 | 软件 | ID

评论列表

所有评论
[85] [86] [87] [88] [89] [90] [91] [92] [93] [94]  ... [143]  
zcmjw 于 2008-12-30 04:37 PM 发表评论:
再剖:结果如何再导入CAD 软件中?
查看所评论的日志:用VB实现BMP JPG GiF 等图片转换成CAD的DwG文件
单眼皮 于 2008-12-30 11:27 AM 发表评论:
abcd3456@126.com
谢谢大虾
查看所评论的日志:PKPM结构软件从入门到精通.pdf
tiancao1001 于 2008-12-29 04:47 PM 发表评论:
还有一个在CAD的VBA里面的文件。
在田草工具箱源文件中,可以找到
查看所评论的日志:用VB实现BMP JPG GiF 等图片转换成CAD的DwG文件
zcmjw 于 2008-12-29 01:07 PM 发表评论:
试问站长:
   转换结果导出并保存TXT文件,如何再导入CAD 软件中????
 谢谢!!!!!
查看所评论的日志:用VB实现BMP JPG GiF 等图片转换成CAD的DwG文件
tiancao1001 于 2008-12-28 11:18 AM 发表评论:
'平法梁配筋率分析
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
查看所评论的日志:VBA平法梁配筋率分析
gohoujing 于 2008-12-28 10:47 AM 发表评论:
辛苦传份给我!
gohoujing@yahoo.com.cn  谢谢
查看所评论的日志:中望CAD vba 教程
gohoujing 于 2008-12-28 10:41 AM 发表评论:
有劳大虾发份给我!
gohoujing@yahoo.com.cn     谢谢!
查看所评论的日志:推荐西北凡人制作的AutoCAD VBA教程【电子书】
gohoujing 于 2008-12-28 10:34 AM 发表评论:
辛苦传给我!
gohoujing@yahoo.com.cn  谢谢!
查看所评论的日志:AutoCAD VBA 二次开发教程源码
[85] [86] [87] [88] [89] [90] [91] [92] [93] [94]  ... [143]  
Tiancao Blog All Rights Reserved 田草博客 版权所有
Copyright ©