田草博客
日志搜索


 标题   内容 评论


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

微信 公众号:ByCAD

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

用户登陆
用户:
密码:
 

站点日历
73 2019 - 3 48
     12
3456789
10111213141516
17181920212223
24252627282930
31


站点统计

最新评论



CAD 五角星绘制 布尔运算
未知 CAD VBA 绘制一般棱台   [ 日期:2007-01-24 ]   [ 来自:本站原创 ]  HTML


CAD VBA 绘制一般棱台

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

'绘制圆台***********************************************绘制圆台*********************************
'    PA------A1-------PB
'     |                   |
'     B1                B1
'     |                   |
'    PC------A1-------PD
'

Sub DrawLT()
    Dim A1 As Double, B1 As Double, A2 As Double, B2 As Double, H As Double
    On Error GoTo ex:
    '输入棱台的尺寸
    ThisDrawing.Utility.InitializeUserInput 1, ""
    A1 = ThisDrawing.Utility.GetReal("棱台底面长(A1):")
    ThisDrawing.Utility.InitializeUserInput 1, ""
    B1 = ThisDrawing.Utility.GetReal("棱台底面宽(B1):")
    ThisDrawing.Utility.InitializeUserInput 1, ""
    A2 = ThisDrawing.Utility.GetReal("棱台顶面长(A2):")
    ThisDrawing.Utility.InitializeUserInput 1, ""
    B2 = ThisDrawing.Utility.GetReal("棱台顶面宽(B2):")
    ThisDrawing.Utility.InitializeUserInput 1, ""
    H = ThisDrawing.Utility.GetReal("棱台高(H):")
    Dim PO As Variant
    ThisDrawing.Utility.InitializeUserInput 1, ""
    PO = ThisDrawing.Utility.GetPoint(, "指定基点:  ")

    '计算棱台的八个角点的坐标
    Dim PA(2) As Double, PB(2) As Double, PC(2) As Double, PD(2) As Double
    Dim PE(2) As Double, PF(2) As Double, PG(2) As Double, PH(2) As Double
    PA(0) = 0 + PO(0):    PA(1) = 0 + PO(1):     PA(2) = 0 + PO(2)
    PB(0) = A1 + PO(0):   PB(1) = 0 + PO(1):     PB(2) = 0 + PO(2)
    PC(0) = 0 + PO(0):    PC(1) = 0 + PO(1):     PC(2) = B1 + PO(2)
    PD(0) = A1 + PO(0):   PD(1) = 0 + PO(1):     PD(2) = B1 + PO(2)
    PE(0) = (A1 - A2) / 2 + PO(0):      PE(1) = H + PO(1):    PE(2) = (B1 - B2) / 2 + PO(2)
    PF(0) = (A1 - A2) / 2 + A2 + PO(0): PF(1) = H + PO(1):    PF(2) = (B1 - B2) / 2 + PO(2)
    PG(0) = (A1 - A2) / 2 + PO(0):      PG(1) = H + PO(1):    PG(2) = (B1 - B2) / 2 + B2 + PO(2)
    PH(0) = (A1 - A2) / 2 + A2 + PO(0): PH(1) = H + PO(1):    PH(2) = (B1 - B2) / 2 + B2 + PO(2)

    ' ThisDrawing.ModelSpace.AddPoint PA
    ' ThisDrawing.ModelSpace.AddPoint PB
    ' ThisDrawing.ModelSpace.AddPoint PC
    ' ThisDrawing.ModelSpace.AddPoint PD
    ' ThisDrawing.ModelSpace.AddPoint PE
    ' ThisDrawing.ModelSpace.AddPoint PF
    ' ThisDrawing.ModelSpace.AddPoint PG
    ' ThisDrawing.ModelSpace.AddPoint PH
    '找出五个尺寸中最大的一个,用来绘制正方体
    Dim Max As Double
    Max = 0
    If A1 > Max Then Max = A1
    If B1 > Max Then Max = B1
    If A2 > Max Then Max = A2
    If B2 > Max Then Max = B2
    If H > Max Then Max = H

    '绘制的正方体中心
    Dim PO_1(2) As Double
    PO_1(0) = PO(0) + A1 / 2: PO_1(1) = PO(1) + H / 2: PO_1(2) = PO(2) + B1 / 2
    '绘制正方体,之所以绘制出个最大尺寸的正方,而不是长方体。是因为WPS和UPS坐标的问题,容易出现棱台的八个点不在长方体内。
    Dim xRecTangle As Acad3DSolid
    Set xRecTangle = ThisDrawing.ModelSpace.AddBox(PO_1, Max, Max, Max)
    '按照的八个顶点做成的六个面分别剖切正方体,从而生成一个棱台。
    Dim SliceObj1 As Acad3DSolid, SliceObj2 As Acad3DSolid ', SliceObj3 As Acad3DSolid, SliceObj4 As Acad3DSolid
    Set SliceObj1 = xRecTangle.SliceSolid(PA, PB, PE, True)
    xRecTangle.Delete
    Set SliceObj2 = SliceObj1.SliceSolid(PA, PC, PE, True)
    SliceObj2.Delete
    Set SliceObj2 = SliceObj1.SliceSolid(PC, PD, PH, True)
    SliceObj2.Delete
    Set SliceObj2 = SliceObj1.SliceSolid(PB, PD, PH, True)
    SliceObj1.Delete
    Set SliceObj1 = SliceObj2.SliceSolid(PA, PB, PC, True)
    SliceObj1.Delete
    Set SliceObj1 = SliceObj2.SliceSolid(PE, PF, PG, True)
    SliceObj2.Delete
    Exit Sub
ex:
    ThisDrawing.Utility.Prompt Err.Description
    Err.Clear
    Exit Sub
End Sub


其实用CAD绘制棱台是很不方便,有个方法其实操作起来不难,难再我门不知道其倾斜角度。这个方法就是拉伸面域,输入拉伸高度和角度(这个角度是什么角度?) 我也忘记了 等我回去看看再写上来。

这个角度是侧面和垂直面的夹角





[本日志由 田草 于 2008-02-20 02:15 PM 编辑]


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

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

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