CAD 注释
Function DrawMark(Point1 As Variant, Point2 As Variant)
Dim XS As Double
Dim YS As Double
XS = Abs(Point1(0) - Point2(0)) / 1000
YS = Abs(Point1(1) - Point2(1)) / 400
Dim Point3 As Variant
Dim Plist(21) As Double
'ThisDrawing.Utility.InitializeUserInput 1, ""
Point3 = ThisDrawing.Utility.GetPoint(, "请点取注释点:")
Plist(0) = Point3(0): Plist(1) = Point3(1)
Plist(2) = Point3(0) + 450 * XS: Plist(3) = Point3(1) + 150 * YS
Plist(4) = Point3(0) + 950 * XS: Plist(5) = Point3(1) + 150 * YS
Plist(6) = Point3(0) + 1000 * XS: Plist(7) = Point3(1) + 200 * YS
Plist(8) = Point3(0) + 1000 * XS: Plist(9) = Point3(1) + 500 * YS
Plist(10) = Point3(0) + 950 * XS: Plist(11) = Point3(1) + 550 * YS
Plist(12) = Point3(0) + 50 * XS: Plist(13) = Point3(1) + 550 * YS
Plist(14) = Point3(0) + 0 * XS: Plist(15) = Point3(1) + 500 * YS
Plist(16) = Point3(0) + 0 * XS: Plist(17) = Point3(1) + 200 * YS
Plist(18) = Point3(0) + 50 * XS: Plist(19) = Point3(1) + 150 * YS
Plist(20) = Point3(0) + 300 * XS: Plist(21) = Point3(1) + 150 * YS
Dim PL As AcadLWPolyline
Set PL = ThisDrawing.ModelSpace.AddLightWeightPolyline(Plist)
PL.Closed = True
PL.SetBulge 2, Tan(Atn(1) * 2 / 4)
PL.SetBulge 4, Tan(Atn(1) * 2 / 4)
PL.SetBulge 6, Tan(Atn(1) * 2 / 4)
PL.SetBulge 8, Tan(Atn(1) * 2 / 4)
Dim Txt As String
Txt = ThisDrawing.Utility.GetString(False, "请输入注释内容:")
Dim p1(2) As Double, p2(2) As Double
p1(0) = Point3(0) + 950 * XS: p1(1) = Point3(1) + 200 * YS: p1(2) = 0
p2(0) = Point3(0) + 50 * XS: p2(1) = Point3(1) + 500 * YS: p1(2) = 0
Dim MarkText As AcadText
Set MarkText = 文字填充模块(Txt, p1, p2, 0)
AddLayer "标记"
ThisDrawing.Layers("标记").color = acYellow
PL.Layer = "标记"
MarkText.Layer = "标记"
End Function
Dim XS As Double
Dim YS As Double
XS = Abs(Point1(0) - Point2(0)) / 1000
YS = Abs(Point1(1) - Point2(1)) / 400
Dim Point3 As Variant
Dim Plist(21) As Double
'ThisDrawing.Utility.InitializeUserInput 1, ""
Point3 = ThisDrawing.Utility.GetPoint(, "请点取注释点:")
Plist(0) = Point3(0): Plist(1) = Point3(1)
Plist(2) = Point3(0) + 450 * XS: Plist(3) = Point3(1) + 150 * YS
Plist(4) = Point3(0) + 950 * XS: Plist(5) = Point3(1) + 150 * YS
Plist(6) = Point3(0) + 1000 * XS: Plist(7) = Point3(1) + 200 * YS
Plist(8) = Point3(0) + 1000 * XS: Plist(9) = Point3(1) + 500 * YS
Plist(10) = Point3(0) + 950 * XS: Plist(11) = Point3(1) + 550 * YS
Plist(12) = Point3(0) + 50 * XS: Plist(13) = Point3(1) + 550 * YS
Plist(14) = Point3(0) + 0 * XS: Plist(15) = Point3(1) + 500 * YS
Plist(16) = Point3(0) + 0 * XS: Plist(17) = Point3(1) + 200 * YS
Plist(18) = Point3(0) + 50 * XS: Plist(19) = Point3(1) + 150 * YS
Plist(20) = Point3(0) + 300 * XS: Plist(21) = Point3(1) + 150 * YS
Dim PL As AcadLWPolyline
Set PL = ThisDrawing.ModelSpace.AddLightWeightPolyline(Plist)
PL.Closed = True
PL.SetBulge 2, Tan(Atn(1) * 2 / 4)
PL.SetBulge 4, Tan(Atn(1) * 2 / 4)
PL.SetBulge 6, Tan(Atn(1) * 2 / 4)
PL.SetBulge 8, Tan(Atn(1) * 2 / 4)
Dim Txt As String
Txt = ThisDrawing.Utility.GetString(False, "请输入注释内容:")
Dim p1(2) As Double, p2(2) As Double
p1(0) = Point3(0) + 950 * XS: p1(1) = Point3(1) + 200 * YS: p1(2) = 0
p2(0) = Point3(0) + 50 * XS: p2(1) = Point3(1) + 500 * YS: p1(2) = 0
Dim MarkText As AcadText
Set MarkText = 文字填充模块(Txt, p1, p2, 0)
AddLayer "标记"
ThisDrawing.Layers("标记").color = acYellow
PL.Layer = "标记"
MarkText.Layer = "标记"
End Function
[本日志由 田草 于 2008-01-09 07:33 PM 编辑]
|
暂时没有评论
发表评论 - 不要忘了输入验证码哦! |