田草博客
日志搜索


 标题   内容 评论


网友交流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 中常用的函数块
未知 由轴线直接生成框架梁或柱   [ 日期:2007-04-01 ]   [ 来自:本站原创 ]  HTML


由轴线直接生成框架梁或柱


程序代码:[ 复制代码到剪贴板 ]
'由轴线直接生成框架梁或柱
Sub kuangjia()
    On Error GoTo ErrControl
    Dim W As Double
    Dim H As Double
    ThisDrawing.Utility.InitializeUserInput 1, ""
    W = ThisDrawing.Utility.GetInteger("请输入创建的实体截面宽度: ")
    ThisDrawing.Utility.InitializeUserInput 1, ""
    H = ThisDrawing.Utility.GetInteger("请输入创建的实体截面高度: ")
    
    Dim L As AcadLine
    'Dim A As Double
    Dim P As Variant
    Dim P1 As Variant
    Dim P2 As Variant
    Dim P3(0 To 2)   As Double
    Dim M(0 To 5) As Double
    Dim A As Double, B As Double, C As Double, D As Double
    Dim T(0 To 2) As Double
    Dim Box As Acad3DSolid
    Dim J As Double
    Dim L1 As Double, L2 As Double, L3 As Double
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = CreateSelectionSet("TempObj")
    Dim FType, FData
    BuildFilter FType, FData, 0, "line"
    ssetObj.SelectOnScreen FType, FData

    ActiveDocument.Utility.Prompt "共选择直线:" & ssetObj.Count & "根" & vbCrLf
    For i = 0 To ssetObj.Count - 1
        If ssetObj.item(i).ObjectName = "AcDbLine" Then
            Set L = ssetObj.item(i)
            MsgBox L.Length
            P = CenterPoint(L.StartPoint, L.EndPoint)
            P1 = L.StartPoint
            P2 = L.EndPoint
            Set Box = ThisDrawing.ModelSpace.AddBox(P, L.Length, W, H)
        
            P3(0) = P(0) + L.Length / 2
            P3(1) = P(1)
            P3(2) = P(2)
        
            '判断三点是否在一条直线上
            If ThreeP_IsOnline(P1, P2, P3) = True Then
                ThisDrawing.Utility.Prompt "出现三点共线情况" & vbCrLf
                Exit Sub
            End If
            '计算平面方程系数
            M(0) = P2(0) - P1(0)
            M(1) = P2(1) - P1(1)
            M(2) = P2(2) - P1(2)
            M(3) = P3(0) - P1(0)
            M(4) = P3(1) - P1(1)
            M(5) = P3(2) - P1(2)
            '计算平面方程系数( Ax+By+Cz+D=0)
            A = M(1) * M(5) - M(2) * M(4)
            B = -(M(0) * M(5) - M(2) * M(3))
            C = M(0) * M(4) - M(1) * M(3)
            D = -A * P1(0) - B * P1(1) - C * P1(2)
            
            
            '过平面法线的一点
            T(0) = A * 10 + P(0)
            T(1) = B * 10 + P(1)
            T(2) = C * 10 + P(2)
            
            Box.Color = acGreen
            
            '计算空间两条直线的夹角
            L1 = L.Length / 2
            L2 = P2PDistance(P, P3)
            L3 = P2PDistance(P3, P1)
            
            '利用余弦定理 a^2=b^2+c^2-2*b*c*cos(A)
            
            J = Arccos((L1 * L1 + L2 * L2 - L3 * L3) / 2 / L1 / L2)
            
            Box.Rotate3d P, T, J
        End If
    Next i
    ssetObj.Delete
    
    Exit Sub

ErrControl:
    
    MsgBox Err.Description

End Sub


上面的代码有个问题, 就是一旦出现三点共线的情况 就推出for循环了。其实不应该的,出现三点共线 就说明这个实体根本不用选择,直接处理下一个就可以了。所以在  改为如下:
          '判断三点是否在一条直线上
            If ThreeP_IsOnline(P1, P2, P3) = True Then
                ThisDrawing.Utility.Prompt "出现三点共线情况" & vbCrLf
                Goto xNext
            End If
             …………
xNext:
       End if
Next i
 ……  




[本日志由 田草 于 2007-04-14 05:06 PM 编辑]


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

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

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