田草博客
日志搜索


 标题   内容 评论


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

微信 公众号:ByCAD

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

用户登陆
用户:
密码:
 

站点日历
73 2019 - 6 48
      1
2345678
9101112131415
16171819202122
23242526272829
30


站点统计

最新评论



田草CAD工具箱(VBA)安装程序(2009.04.13) VB 晴雨表
未知 CAD VBA 极坐标标注   [ 日期:2007-01-26 ]   [ 来自:本站原创 ]  HTML


CAD VBA 极坐标标注


'*******************************************************************************************

'极坐标标注*****************************************************极坐标标注*********************
'   调用AddDimAlignedCTxt
Sub DimJZB()
    Dim Pi As Double ' 圆周率
    Pi = 3.14159265358973
    '获取线段各属性
    Dim jd  As Variant '极坐标角度
    Dim BJ  As Double   '极坐标半径
    Dim ZD(0 To 2)  As Double  '极坐标半径中点
    Dim WS As Integer '输入标注精度
    Dim JDGS As Integer '输入角度格式
    Dim D As Variant '选择标注点
    '选择极坐标原点
    Dim YD  As Variant

    On Error Resume Next
    ThisDrawing.Utility.InitializeUserInput 1, ""
    WS = ThisDrawing.Utility.GetInteger("输入标注精度(小数点后几位数):")
    '第一个参数设置为1以强制用户输入关键字,但不接受 NULL 输入(即按 ENTER 键)
    ThisDrawing.Utility.InitializeUserInput 0, "0 1 2"
    '提示关键字供用户选择
    JDGS = ThisDrawing.Utility.GetKeyword(vbCrLf & "角度格式[十进制(0)/弧度制(1)]<度分秒(2)>:")
    
xNext:
    On Error GoTo E:

    D = ThisDrawing.Utility.GetPoint(, "选择标注点:")

    YD = ThisDrawing.Utility.GetPoint(D, "选择极坐标原点:")

    Dim XD As AcadLine
    Set XD = ThisDrawing.ModelSpace.AddLine(YD, D)
    jd = XD.angle
    If JDGS = 0 Then
        '将角度转换成十进制表示
        jd = 180 * jd / Pi
        jd = Format(jd, "0.0000")
    ElseIf JDGS = 2 Then
        '将角度转换成十进制表示
        jd = 180 * jd / Pi
        jd = Format(jd, "0.0000")
        '将角度转换成 度分秒
        jd = jd * 3600
        jd = jd \ 3600 & "%%d" & (jd \ 60) Mod 60 & "'" & jd Mod 60 & """"
    Else
        '仍然用弧度制表示 仅将精度控制在四位数
        jd = Format(jd, "0.0000")
    End If
    '计算半径长度
    BJ = Sqr(((D(0) - YD(0)) ^ 2 + (D(1) - YD(1)) ^ 2 + (D(2) - YD(2)) ^ 2))
    '半径标注转变精度
    Select Case WS
      Case 0
        BJ = Int(BJ)
      Case 1
        BJ = Int(BJ * 10) / 10
      Case 2
        BJ = Int(BJ * 100) / 100
      Case 3
        BJ = Int(BJ * 1000) / 1000
      Case 4
        BJ = Int(BJ * 10 ^ 4) / 10 ^ 4
      Case 5
        BJ = Int(BJ * 10 ^ 5) / 10 ^ 5
      Case 6
        BJ = Int(BJ * 10 ^ 6) / 10 ^ 6
      Case 7
        BJ = Int(BJ * 10 ^ 7) / 10 ^ 7
      Case 8
        BJ = Int(BJ * 10 ^ 8) / 10 ^ 8
      Case 9
        BJ = Int(BJ * 10 ^ 9) / 10 ^ 9
    End Select

    '计算中点坐标
    ZD(0) = (D(0) + YD(0)) / 2
    ZD(1) = (D(1) + YD(1)) / 2
    ZD(2) = (D(2) + YD(2)) / 2

    '标注
    AddDimAlignedCTxt D, YD, ZD, "R=" & BJ & " A=" & jd
    XD.Delete
    GoTo xNext
E:
End Sub
'****************************************************************************************




[本日志由 田草 于 2007-11-24 10:04 AM 编辑]


引用这个评论 田草 于 2007-01-26 02:19 PM 发表评论: 
哈哈 我现在还经常用用,什么现场布置,电子放样、计算工程量等。

最近这边活比较少,有空更新。

引用这个评论 dylan_sue 于 2007-01-26 02:02 PM 发表评论: 
你每天都更新吗?厉害,我的博现在是一周才换一次水,刚开始还能保证每天都传新日志的.
CAD现在我已经不用了,几乎都快不会用了,哎!四年大学好象对我只是为了那张毕业证

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

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

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