用户登陆
站点日历
站点统计
最新评论
CAD 用VBA建立带属性块 [ 日期：2007-05-13 ] [ 来自：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
|
|
暂时没有评论
| 发表评论 - 不要忘了输入验证码哦！ |