田草博客

互联网田草博客


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

微信 公众号:ByCAD

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

用户登陆
用户:
密码:
 

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


站点统计

最新评论



归并图层和字体样式 lisp和vba相互传递变量
未知 折断线绘制   [ 日期:2007-11-23 ]   [ 来自:本站原创 ]  HTML
折断线绘制



按此在新窗口打开图片


'********************************************************************************************
'折断线绘制***********************************************折断线绘制****************************
'
Sub DrawDDX()
    On Error GoTo E:
    Dim P1 As Variant, P2 As Variant
    ThisDrawing.Utility.InitializeUserInput 1, ""
    P1 = ThisDrawing.Utility.GetPoint(, "指定折断的第一点:  ")
    ThisDrawing.Utility.InitializeUserInput 1, ""
    P2 = ThisDrawing.Utility.GetPoint(P1, "指定折断的第二点:  ")
    Dim XD As AcadLine
    Set XD = ThisDrawing.ModelSpace.AddLine(P1, P2)
    '计算中点坐标
    Dim PO(2)  As Double
    PO(0) = (P1(0) + P2(0)) / 2: PO(1) = (P1(1) + P2(1)) / 2: PO(2) = (P1(2) + P2(2)) / 2

    '计算其他点坐标

    Dim P3(2) As Double, P4(2) As Double, P5(2) As Double, P6(2) As Double, P7(2) As Double, P8(2) As Double
    Dim Pi As Double ' 圆周率
    'Pi = 3.14159265358973
    Pi = 4 * Atn(1) '计算圆周率,反正切直为1对应的是45度。
    '圆的半径
    Dim R As Double
    R = XD.Length

    P3(0) = PO(0) + Cos(XD.angle + Pi / 2 - 1 * Pi / 9) * 0.15 * R  '90-20度
    P3(1) = PO(1) + Sin(XD.angle + Pi / 2 - 1 * Pi / 9) * 0.15 * R
    P3(2) = P1(2)
    
    
    P4(0) = PO(0) + Cos(XD.angle + 3 * Pi / 2 - 1 * Pi / 9) * 0.15 * R '270-20度
    P4(1) = PO(1) + Sin(XD.angle + 3 * Pi / 2 - 1 * Pi / 9) * 0.15 * R
    P4(2) = P1(2)

    P5(0) = PO(0) + Cos(XD.angle) * 0.1 * R
    P5(1) = PO(1) + Sin(XD.angle) * 0.1 * R
    P5(2) = P1(2)
    
    P6(0) = PO(0) + Cos(XD.angle + Pi) * 0.1 * R
    P6(1) = PO(1) + Sin(XD.angle + Pi) * 0.1 * R
    P6(2) = P1(2)

    P7(0) = PO(0) + Cos(XD.angle) * R * 0.7
    P7(1) = PO(1) + Sin(XD.angle) * R * 0.7
    P7(2) = P1(2)

    P8(0) = PO(0) + Cos(XD.angle + Pi) * R * 0.7
    P8(1) = PO(1) + Sin(XD.angle + Pi) * R * 0.7
    P8(2) = P1(2)
    XD.Delete
    '二维多线段绘制
    Dim DDX As AcadLWPolyline '三维多线段为AcadPolyline
    Dim P(0 To 11) As Double '三维多线段数组必须是三的陪数,前三个为一个坐标。
    P(0) = P8(0): P(1) = P8(1) '二维两个为一个坐标
    P(2) = P6(0): P(3) = P6(1)
    P(4) = P4(0): P(5) = P4(1)
    P(6) = P3(0): P(7) = P3(1)
    P(8) = P5(0): P(9) = P5(1)
    P(10) = P7(0): P(11) = P7(1)

    ThisDrawing.ModelSpace.AddLightWeightPolyline P '绘制二维多线段,三维多线段为AddPolyline
    End
E:
End Sub
'******************************************************************************************



按此在新窗口打开图片



'*********************************************************************************************
'管道折断线绘制***********************************************管道折断线绘制**********************
'
Sub DrawGDDDX()
    On Error GoTo E:
    '捕捉两个端点
    Dim P1 As Variant, P2 As Variant
    ThisDrawing.Utility.InitializeUserInput 1, ""
    P1 = ThisDrawing.Utility.GetPoint(, "指定折断的第一点:  ")
    ThisDrawing.Utility.InitializeUserInput 1, ""
    P2 = ThisDrawing.Utility.GetPoint(P1, "指定折断的第二点:  ")
    '获得两点间的距离
    'ThisDrawing.ModelSpace.AddPoint P1
    'ThisDrawing.ModelSpace.AddPoint P2

    Dim L As Double
    L = P2PDistance(P1, P2)
    '所画圆弧的半径
    Dim R As Double
    R = 0.6 * L
    '获得中点坐标
    Dim PO(2) As Double, PO1(2) As Double, PO2(2) As Double
    PO(0) = (P1(0) + P2(0)) / 2:      PO(1) = (P1(1) + P2(1)) / 2:       PO(2) = (P1(2) + P2(2)) / 2
    PO1(0) = (P1(0) + PO(0)) / 2:     PO1(1) = (P1(1) + PO(1)) / 2:      PO1(2) = (P1(2) + PO(2)) / 2
    PO2(0) = (P2(0) + PO(0)) / 2:     PO2(1) = (P2(1) + PO(1)) / 2:      PO2(2) = (P2(2) + PO(2)) / 2
    'ThisDrawing.ModelSpace.AddPoint PO
    'ThisDrawing.ModelSpace.AddPoint PO1
    'ThisDrawing.ModelSpace.AddPoint PO2

    '两点与x正方向成的角
    Dim A As Double
    A = ThisDrawing.Utility.AngleFromXAxis(P2, P1)
    '所画圆弧圆心
    Dim Pi As Double ' 圆周率
    'Pi = 3.14159265358973
    Pi = 4 * Atn(1) '计算圆周率,反正切直为1对应的是45度。
    '创建匿名块
    Dim BlockObj As AcadBlock
    Set BlockObj = ThisDrawing.Blocks.Add _
        (P1, "*A")
    '计算三个圆弧的圆心
    Dim C1(2) As Double, C2(2) As Double, C3(2) As Double
    C1(0) = PO1(0) + Cos(A + Pi / 2) * R: C1(1) = PO1(1) + Sin(A + Pi / 2) * R: C1(2) = PO(2)
    'ThisDrawing.ModelSpace.AddPoint C1
    Dim StartA As Double, EndA  As Double, R1 As Double
    '圆弧起点的角度
    '使用 AngleFromXAxis 方法查看直线与 X 轴所成的角度
    StartA = ThisDrawing.Utility.AngleFromXAxis(C1, PO)
    '圆弧终点的角度
    EndA = ThisDrawing.Utility.AngleFromXAxis(C1, P1)
    '圆弧的半径
    R1 = P2PDistance(C1, PO)
    '向块添加圆弧
    BlockObj.AddArc C1, R1, StartA, EndA

    C2(0) = PO2(0) + Cos(A + Pi / 2) * R: C2(1) = PO2(1) + Sin(A + Pi / 2) * R: C2(2) = PO(2)
    'ThisDrawing.ModelSpace.AddPoint C2
    StartA = ThisDrawing.Utility.AngleFromXAxis(C2, P2)
    EndA = ThisDrawing.Utility.AngleFromXAxis(C2, PO)
    BlockObj.AddArc C2, R1, StartA, EndA

    C3(0) = PO2(0) + Cos(A - Pi / 2) * R: C3(1) = PO2(1) + Sin(A - Pi / 2) * R: C3(2) = PO(2)
    'ThisDrawing.ModelSpace.AddPoint C3
    StartA = ThisDrawing.Utility.AngleFromXAxis(C3, PO)
    EndA = ThisDrawing.Utility.AngleFromXAxis(C3, P2)
    BlockObj.AddArc C3, R1, StartA, EndA
    '插入块
    ThisDrawing.ModelSpace.InsertBlock P1, BlockObj.Name, 1, 1, 1, 0
    End
E:
End Sub
'*********************************************************************************************


[本日志由 田草 于 2007-11-23 03:57 PM 编辑]


引用这个评论 tiancao1001 于 2009-02-21 09:14 AM 发表评论: 
你好,
P2PDistance,就是个求点到点的直线距离的,你自己补充吧?
我分享的代码只能提供一种思路,和解决方法。

引用这个评论 luojunxu 于 2009-02-20 11:14 PM 发表评论: 
缺少一个函数P2PDistance

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

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

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