AUTOCAD VBA 旋转并复制对象2006

AUTOCAD VBA 旋转并复制对象2006-11-15 21:39Sub RotatorAndCopy()
On Error GoTo errcontrol
    Dim PT As Variant
    Dim JiaoDu As Double
    Dim NewFilterEnt
xunhuan:
    '创建选择集
    Set FilterSet = ThisDrawing.SelectionSets.Add("xxx")
   
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    '设置过滤器类型
    FilterType(0) = 0
    '设置过滤数据
    FilterData(0) = "line"
   
    '使用过滤器,由用户在屏幕上选择
    FilterSet.SelectOnScreen FilterType, FilterData
    PT = ThisDrawing.Utility.GetPoint(, "指定旋转基点:")
    '第一个参数设置为1以强制用户输入关键字,但不接受 NULL 输入(即按 ENTER 键)
    ThisDrawing.Utility.InitializeUserInput 1, ""
    JiaoDu = ThisDrawing.Utility.GetReal("指定旋转角度:")
    '将十进制角度转换成弧度
    ' 4 * Atn(1)  计算圆周率,反正切直为1对应的是45度。
    JiaoDu = JiaoDu * 4 * Atn(1) / 180
    For Each FilterEnt In FilterSet
        '复制对象
        Set NewFilterEnt = FilterEnt.Copy
        '旋转对象
        NewFilterEnt.Rotate PT, JiaoDu
        '更新对象
        NewFilterEnt.Update
    Next
    '删除选择集
    ThisDrawing.SelectionSets("xxx").Delete
    GoTo xunhuan
    Exit Sub
errcontrol:
  ThisDrawing.SelectionSets("xxx").Delete
End Sub
用vba实现连续旋转复制
程序清单:
Sub copyAndRotate()
Dim ssetObj As AcadSelectionSet
Dim ent As AcadEntity
Dim i As Integer
Dim n As Integer
'新建选择集
On Error Resume Next
ThisDrawing.SelectionSets("New_SelectionSet").Delete
Set ssetObj = ThisDrawing.SelectionSets.Add("New_SelectionSet")
'检查选择集是否为空,是则退出程序
ssetObj.SelectOnScreen
n = ThisDrawing.SelectionSets("New_SelectionSet").Count
If n = 0 Then
Exit Sub
End If
'确定目标点
Dim p1 As Variant
Dim p2 As Variant
Dim k As Double
Dim angle1 As Double
Dim angle2 As Double
Dim angle As Double
交换空间2010p1 = ThisDrawing.Utility.GetPoint(, "请选择旋转中心:")
全文搜索引擎p2 = ThisDrawing.Utility.GetPoint(p1, "请选择基点:")
k = (p2(1) - p1(1)) / (p2(0) - p1(0))
'MsgBox "k=" & k
'除数为零,k=无穷大
If Err = 11 Then
If p2(1) < p1(1) Then
angle1 = 1.5 * 3.14159265358979
Else
angle1 = 0.5 * 3.14159265358979
End If
End If
angle1 = Atn(k)
'p2在第二、三象限
If p2(0) < p1(0) Then
angle1 = angle1 + 3.14159265358979
End If
Dim icount As Integer
While incount < 1000
'如果异常发生,退出程序
If Err <> 0 Then
Exit Sub
Else
p2 = ThisDrawing.Utility.GetPoint(p1, "请选择目标点:")
k = (p2(1) - p1(1)) / (p2(0) - p1(0))
'除数为零,k=无穷大
If Err = 11 Then
If p2(1) < p1(1) Then
angle2 = 1.5 * 3.14159265358979
Else
angle2 = 0.5 * 3.14159265358979
End If
End If
angle2 = Atn(k)
'p2在第二、三象限
If p2(0) < p1(0) Then
angle2 = angle2 + 3.14159265358979
End If
angle = angle2 - angle1
For i = 0 To n - 1
Set ent = ssetObj.Item(i).Copy
ent.Rotate p1, angle
Next
End If
卡尼丁Wend
盗窃罪的构成要件
End Sub
建立三维对象
[ 作者:郑立楷    来源:明经通道    点击数:2503    更新时间:2002-12-6    文章录入:mccad
AutoCAD支持类型的三维模型:框线、网面和实体。每一种类型都有它自己的创建和编辑技巧。
线框模型是一个三维物体的骨架描述。在线框模型中是没有表面的;它只包括描述物体边缘的点、线和曲线。你可以在三维空间的任何位置通过定位一个二维(平面的)物体来建立一个线框模型。AutoCAD也提供了一些三维线框模型,例如三维多义线。因为组成线框模型的每一个对象都是被独立地绘制和定位的,所以画这种类型的模型经常是最耗时的。
表面模型不仅定义了三维物体的边缘,也定义了三维物体的表面,所以它比线框模型更精密。AutoCAD表面模型用一个多边的网面来定义小面积的表面。因为这些网面的表面是平的。所以网面只能近似地描述曲面。
实体模型是最容易使用的三维模型。用AutoCAD实体模型,你可以通过建立基本的三维形状来做三维物体:方体、圆柱、球、楔子和圆环(环状物)。你还可以结合这些形状去建立更复杂的实体模型,如并集、差集或查它们的交集(干涉)。你也可以用一个二维物体扫一个轨迹或用它绕一个轴旋转来建立一个实体。用AutoCAD
设计中心,你也可以定义实心参量和维持三维模型与产生它们的二维视点之间的结合。
注意! 因为每一种模型用了不同的方法来构造三维模型,而且编辑方法对不同的模型会产生不同的影响,所以建议你不要混淆建模方法。模型间的转换只限实体转为表面或表面转为线框,而不可以从线框转为表面或由表面转为实体。
本节主要内容:
建立线框
建立网面
建立多表面网面
建立实体
煤矿领导带班下井及安全监督检查规定
建立线框
用AutoCAD你可以在三维空间的任何位置通过设置任何的二维平面物体来建立线框模型。你可以用几种方法在三维空间安置二维物体:
通过输入三维点来建立对象。你可以输入一个定义了X、Y、Z轴位置的点的坐标。
通过定义一个UCS建立一个你要绘图的默认座标平面(XY平面)
当你建立好对象后,将它移至三维空间的合适方位。
同样,你也可以建立一些线框对象,例如多义线,它可以在三维空间存在。用Add3Dpoly方法可以建立三维多义线。以下的图例是一个用三维多义线和二维抽象位置的组合在三维空间建立的一个三维建模程序。
建立网面
一个矩形的网面(PolygonMesh对象)表示一个对象的表面用的是平坦的小平面。网面的密度,或小平面的数目,被定义在一个以M和N为矩阵的项里,类似一个由行和列组成的栅格。
M和N分别指定了所有给出的顶点的行和列的位置。你可以在二维或三维中建立网面,但它们主要是被用于三维中。
如果你不需要知道可以由实体提供的物理特性(例如质量、重量、重心等等)的细节标准,但你又确实需要隐蔽、阴影、透视功能,而这些功能线框又不能提供,那么你可以用网面来表达。网面对想用不寻常的网面样式来建立几何体也是很有用的,例如一个山的三维地形模型。
一个网面可以是开放的也可以是封闭的。如果网面的起始端不碰到结束端,那么这个网面就对一个特定的方向打开,如下图所示:
陈柳钦
用Add3Dmesh方法可以建立矩形的网面。这个方法要输入三个值:在M方向的顶点的数目、在N方向的顶点的数目以及一个包含在网面中的所有顶点坐标的变体数组。

本文发布于:2024-09-21 22:25:40,感谢您对本站的认可!

本文链接:https://www.17tex.com/xueshu/90953.html

版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系,我们将在24小时内删除。

标签:模型   建立   网面   表面
留言与评论(共有 0 条评论)
   
验证码:
Copyright ©2019-2024 Comsenz Inc.Powered by © 易纺专利技术学习网 豫ICP备2022007602号 豫公网安备41160202000603 站长QQ:729038198 关于我们 投诉建议