田草博客
日志搜索


 标题   内容 评论


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

微信 公众号:ByCAD

邮箱:tiancao1001x126.com
ByCAD,微信公众号
首页 | 普通 | 电脑 | AutoCAD | VB/VB.NET | FLash | 结构 | 建筑 | 电影 | BIM | 规范 | 软件
-电信用户-|-网通用户-
-博客论坛-|-软件下载-
-网站导航-|-规范下载-
-BelovedFLash欣赏-

用户登陆
用户:
密码:
 

站点日历
73 2020 - 6 48
 123456
78910111213
14151617181920
21222324252627
282930


站点统计

最新评论



博客Banner图片更新记录 在Word中插入钢筋符号
未知 CAD 用VBA建立带属性块   [ 日期:2007-05-13 ]   [ 来自:本站原创 ]  HTML
CAD 用VBA建立带属性块


下面是我做的一个A3的图框带属性块。

和大家共同学习一下。

'自动生成国标图框*******************************************************自动生成国标图框*********************************************************
'
Public Function AUTO_TuKuang(ByVal Size As String, ByVal xScale As Integer)
    Dim TuKuang_Layer As AcadLayer
    Dim TuKuang As AcadBlock
    Dim Kuang1  As AcadLWPolyline
    Dim Kuang2 As AcadLWPolyline
    Dim Line As AcadLine
    Dim PO As Variant
    Dim P(7) As Double
    Dim Temp As AcadBlock, temp1 As String, temp2 As Integer, Index As Integer
    PO = ThisDrawing.Utility.GetPoint(, "插入点")
    '判断文档之中是否存在图框系列图层
    '    如果没有,则新建该系列图层
    Dim LayerExist  As Boolean
    For Each TuKuang_Layer In ThisDrawing.Layers
        If TuKuang_Layer.Name = "图框" Then LayerExist = True
    Next
    If LayerExist = False Then
        Set TuKuang_Layer = ThisDrawing.Layers.Add("图框")
        TuKuang_Layer.color = 128
    End If
    '将图框层置为当前层
    If ThisDrawing.ActiveLayer.Name <> "图框" Then ThisDrawing.ActiveLayer = TuKuang_Layer
    '建立图框
    Select Case Size
           Case "A4_H"                              'A4 横向
                '查找是否存在A4_H图框,如果存在则原来的图框序号上增加1
                If ThisDrawing.Blocks.Count > 0 Then
                     For Each Temp In ThisDrawing.Blocks
                        'MsgBox Temp.Name
                        '返回块名称
                        temp1 = Temp.Name
                        '如果是A4_H图框
                        If Left(temp1, 4) = "A4_H" Then
                            '返回A4_H的序号
                            temp2 = Val(Right(temp1, 3))
                            'MsgBox Temp2
                            '返回A4_H图框的最大的序号,放在Index变量中
                            If Index < temp2 Then Index = temp2
                        End If
                    Next
                End If
                Index = Index + 1
                Set TuKuang = ThisDrawing.Blocks.Add(Point3D(0, 0, 0), "A4_H_图框" & Format(Index, "000"))
                '绘制外边框
                P(0) = 0: P(1) = 0: P(2) = 297: P(3) = 0: P(4) = 297: P(5) = 210: P(6) = 0: P(7) = 210
                Set Kuang1 = TuKuang.AddLightWeightPolyline(P)
                With Kuang1
                    .Closed = True
                    .color = acRed
                    .Lineweight = acLnWt030
                    .Layer = "图框"
                End With
                '绘制内边框
                '外边框和内边框相距5毫米,左侧会签栏位2.5公分。
                P(0) = 30: P(1) = 5: P(2) = 292: P(3) = 5: P(4) = 292: P(5) = 205: P(6) = 30: P(7) = 205
                Set Kuang2 = TuKuang.AddLightWeightPolyline(P)
                With Kuang2
                    .Closed = True
                    .color = acBlue
                    .Lineweight = acLnWt025
                    .Layer = "图框"
                End With
                With TuKuang
                    '绘制会签栏
                    .AddLine Point3D(5, 205, 0), Point3D(5, 130, 0)
                    .AddLine Point3D(10, 205, 0), Point3D(10, 130, 0)
                    .AddLine Point3D(15, 205, 0), Point3D(15, 130, 0)
                    .AddLine Point3D(20, 205, 0), Point3D(20, 130, 0)
                    .AddLine Point3D(25, 205, 0), Point3D(25, 130, 0)
                    .AddLine Point3D(5, 205, 0), Point3D(30, 205, 0)
                    .AddLine Point3D(5, 180, 0), Point3D(30, 180, 0)
                    .AddLine Point3D(5, 155, 0), Point3D(30, 155, 0)
                    .AddLine Point3D(5, 130, 0), Point3D(30, 130, 0)
                    '绘制标题栏
                    '标题栏宽6公分,高3.5公分
                        Set Line = .AddLine(Point3D(292, 40, 0), Point3D(207, 40, 0))
                        Line.Lineweight = acLnWt025
                        Line.color = acBlue
                        Set Line = .AddLine(Point3D(207, 40, 0), Point3D(207, 5, 0))
                        Line.Lineweight = acLnWt025
                        Line.color = acBlue
                        '标题栏内网格线按照从上到下,从左到右绘制
                            .AddLine Point3D(217, 5, 0), Point3D(217, 25, 0)
                            .AddLine Point3D(232, 5, 0), Point3D(232, 40, 0)
                            .AddLine Point3D(240, 5, 0), Point3D(240, 10, 0)
                            .AddLine Point3D(260, 5, 0), Point3D(260, 10, 0)
                            .AddLine Point3D(268, 5, 0), Point3D(268, 10, 0)
                            .AddLine Point3D(276, 5, 0), Point3D(276, 10, 0)
                            .AddLine Point3D(284, 5, 0), Point3D(284, 10, 0)
                
                            .AddLine Point3D(232, 32, 0), Point3D(292, 32, 0)
                            .AddLine Point3D(207, 10, 0), Point3D(292, 10, 0)
                            .AddLine Point3D(207, 15, 0), Point3D(232, 15, 0)
                            .AddLine Point3D(207, 20, 0), Point3D(232, 20, 0)
                            .AddLine Point3D(207, 25, 0), Point3D(292, 25, 0)
                        '标题栏中添加文字
                        Dim H As Double
                        Dim Att As AcadAttribute
                        H = 文字填充高度("制图", Point3D(207, 5, 0), Point3D(217, 10, 0), 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "制图", Point3D(207, 5, 0), "制图", "制图")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(212, 7.5, 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "设计", Point3D(207, 10, 0), "设计", "设计")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(212, 12.5, 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "校对", Point3D(207, 15, 0), "校对", "校对")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(212, 17.5, 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "审核", Point3D(207, 20, 0), "审核", "审核")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(212, 22.5, 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "制图人姓名", Point3D(217, 5, 0), "制图人", "田  草")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(224.5, 7.5, 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "设计人姓名", Point3D(217, 10, 0), "设计人", "田  草")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(224.5, 12.5, 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "校对人姓名", Point3D(217, 15, 0), "校对人", "田  草")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(224.5, 17.5, 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "审核人姓名", Point3D(217, 20, 0), "审核人", "田  草")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(224.5, 22.5, 0)
                        H = 文字填充高度("江苏省宿迁市xx建设集团", Point3D(232, 32, 0), Point3D(292, 40, 0), 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "公司名称", Point3D(0, 0, 0), "公司名称", "江苏省宿迁市xx建设集团")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(262, 36, 0)
                        H = 文字填充高度("江苏省宿迁市xx建设集团综合办公楼", Point3D(232, 25, 0), Point3D(292, 32, 0), 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "工程名称", Point3D(0, 0, 0), "工程名称", "江苏省宿迁市xx建设集团综合办公楼")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(262, 28.5, 0)
                        H = 文字填充高度("施工总平面图", Point3D(232, 25, 0), Point3D(292, 10, 0), 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "图纸名称", Point3D(0, 0, 0), "图纸名称", "施工总平面图")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(262, 17.5, 0)
                        H = 文字填充高度("日期", Point3D(232, 5, 0), Point3D(240, 10, 0), 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "日期", Point3D(0, 0, 0), "日期", "日期")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(236, 7.5, 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "图别", Point3D(0, 0, 0), "图别", "图别")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(264, 7.5, 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "建施", Point3D(0, 0, 0), "建施", "建施")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(272, 7.5, 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "图号", Point3D(0, 0, 0), "图号", "图号")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(280, 7.5, 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "图号", Point3D(0, 0, 0), "图号", "0001")
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(288, 7.5, 0)
                        Dim DateString As String
                        DateString = Year(Now) & "年" & Month(Now) & "月" & Day(Now) & "日"
                        H = 文字填充高度(DateString, Point3D(240, 5, 0), Point3D(260, 10, 0), 0)
                        Set Att = .AddAttribute(H, acAttributeModeNormal, "日期", Point3D(0, 0, 0), "日期", DateString)
                        Att.Alignment = acAlignmentMiddleCenter
                        Att.Move Att.TextAlignmentPoint, Point3D(250, 7.5, 0)
                        '公司图标
                        
                        '会签栏
                        
                     '绘制中心线
                    Set Line = .AddLine(Point3D(161, 0, 0), Point3D(161, 5, 0))
                    Line.Lineweight = acLnWt030
                    Set Line = .AddLine(Point3D(292, 105, 0), Point3D(297, 105, 0))
                    Line.Lineweight = acLnWt030
                    Set Line = .AddLine(Point3D(161, 205, 0), Point3D(161, 210, 0))
                    Line.Lineweight = acLnWt030
                    Set Line = .AddLine(Point3D(25, 105, 0), Point3D(30, 105, 0))
                    Line.Lineweight = acLnWt030
                End With
                ThisDrawing.ModelSpace.InsertBlock PO, TuKuang.Name, xScale, xScale, xScale, 0
            
           Case "A4_V"                             'A4 竖向
           
           Case "A3_H"
           
           Case "A3_V"
           Case "A2_H"
           Case "A2_V"
           Case "A1_H"
           Case "A1_V"
           Case "A0_H"
           Case "A0_V"
    End Select
End Function





暂时没有评论
发表评论 - 不要忘了输入验证码哦!
作者: 用户:  密码:   注册? 验证:  防止恶意留言请输入问题答案:1*7=?  
评论:

禁止表情
禁止UBB
禁止图片
识别链接
识别关键字

字体样式 文字大小 文字颜色
插入粗体文本 插入斜体文本 插入下划线
左对齐 居中对齐 右对齐
插入超级链接 插入邮件地址 插入图像
插入 Flash 插入代码 插入引用
插入列表 插入音频文件 插入视频文件
插入缩进符合
点击下载按钮 下标 上标
水平线 简介分割标记
表  情
 
Tiancao Blog All Rights Reserved 田草博客 版权所有
Copyright ©