田草博客

互联网田草博客


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

微信 公众号:ByCAD

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

用户登陆
用户:
密码:
 

站点日历
73 2024 - 11 48
     12
3456789
10111213141516
17181920212223
24252627282930


站点统计

最新评论



CAD VBA 实现图纸的快速打印 CAD 型钢断面绘制
未知 CAD 注释   [ 日期:2007-08-15 ]   [ 来自:本站原创 ]  HTML
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



[本日志由 田草 于 2008-01-09 07:33 PM 编辑]


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

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

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