|
![](https://clubstatic.excelhome.net/image/common/ico_lz.png)
楼主 |
发表于 2020-8-6 10:44
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
4、复制单个图形:Copy无参数,该方法会将图形在原位置复制一次代码示例↓↓↓
- Sub CopyPolyline()
- Dim doct As AcadDocument
- Set doct = doc
- If doct Is Nothing Then Exit Sub
- '创建多段线
- Dim pt(0 To 7) As Double
- pt(0) = 0: pt(1) = 0
- pt(2) = 100: pt(3) = 0
- pt(4) = 100: pt(5) = 200
- Set plineObj = doct.ModelSpace.AddLightWeightPolyline(pt)
- plineObj.Closed = True
- ' 复制多段线
- Set CopyplineObj = plineObj.Copy
- End Sub
复制代码 代码中画了一个多段线三角形,利用Copy方法在原位置复制了一个,Copy方法可以配合Move方法将复制的图形移动到其他位置。
5、复制多个图形:CopyObjects(存储对象的数组)数组下限必须是0,类型必须是Object或AcadEntity
代码示例↓↓↓
- Sub CopyPolylineAll()
- Dim doct As AcadDocument
- Set doct = doc
- If doct Is Nothing Then Exit Sub
- '定义储存图形的数组
- Dim objT(0 To 1) As Object
- '创建多段线
- Dim pt(0 To 7) As Double
- pt(0) = 0: pt(1) = 0
- pt(2) = 100: pt(3) = 0
- pt(4) = 100: pt(5) = 200
- Set plineObj = doct.ModelSpace.AddLightWeightPolyline(pt)
- plineObj.Closed = True
- '创建圆
- Dim centerPoint(0 To 2) As Double
- Dim rad As Double
- centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0
- rad = 150
- Set CircleObj = doct.ModelSpace.AddCircle(centerPoint, rad)
- ' 将图形放入objT数组中
- Set objT(0) = plineObj
- Set objT(1) = CircleObj
- ' 复制对象并返回新对象(拷贝)的数组
- objTx = doct.CopyObjects(objT)
- End Sub
复制代码 代码中画了一个多段线三角形,一个圆形,并且将图形都放入objT数组中,利用CopyObjects方法将数组中的图形原位置复制一次。
CopyObjects方法扩展:该方法可以将图形从一个CAD文档复制到另一个文档中,利用他的第二可选参数
CopyObjects(存储对象的数组,[图形文档的图形对象集合ModelSpace])
- Sub CopyPolylineAll_to_doc2()
- Dim doct As AcadDocument
- Set doct = doc
- If doct Is Nothing Then Exit Sub
- '定义储存图形的数组
- Dim objT(0 To 1) As Object
- '创建多段线
- Dim pt(0 To 7) As Double
- pt(0) = 0: pt(1) = 0
- pt(2) = 100: pt(3) = 0
- pt(4) = 100: pt(5) = 200
- Set plineObj = doct.ModelSpace.AddLightWeightPolyline(pt)
- plineObj.Closed = True
- '创建圆
- Dim centerPoint(0 To 2) As Double
- Dim rad As Double
- centerPoint(0) = 0: centerPoint(1) = 0: centerPoint(2) = 0
- rad = 150
- Set CircleObj = doct.ModelSpace.AddCircle(centerPoint, rad)
- ' 将图形放入objT数组中
- Set objT(0) = plineObj
- Set objT(1) = CircleObj
- ' 新建一个CAD文档
- Set ACADApp = GetObject(, "AutoCAD.Application")
- Dim doct2 As AcadDocument
- Set doct2 = ACADApp.Documents.Add
- ' 复制图形到新建文档的ModelSpace集合
- objTx = doct.CopyObjects(objT, doct2.ModelSpace)
- End Sub
复制代码 代码后半部分用Set doct2 = ACADApp.Documents.Add新建了一个文档doct2,用CopyObjects方法将图形复制到doct2.ModelSpace集合中。
|
评分
-
2
查看全部评分
-
|