[求助]：如何将选中的实体保存到另一个文件？

gephen · 发表于 2004-1-8 17:47:14

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

如何将选中的实体保存到另一个文件？
要求原有的实体属性不变。

efan2000 · 发表于 2004-1-8 19:51:19

1、创建一个对象数组，保存选中实体。如：Dim objCollection(0 To 1) As Object
2、打开那个文件，如：doc。
3、使用ThisDrawing.CopyObjects objCollection,doc，将实体拷贝到刚打开的文件中。

gephen · 发表于 2004-1-9 10:22:00

CopyObjects 的参数如何设置，我老是设不对
doc1 对象所在文件
doc2 目标文件
objCollection 对象集
doc1.CopyObjects (objCollection， doc2)
但我这样设后，还是出错，“CopyObjects 不能应用在IAcadDocument 上"

zkycds · 发表于 2004-1-16 09:18:28

用Wblock

Sub Example_WBlock()
' This example creates several objects in model space and
' adds them to a selection set. This selection set is then
' output as a new drawing file.
' Create a Ray object in model space
Dim rayObj As AcadRay
Dim basePoint(0 To 2) As Double
Dim SecondPoint(0 To 2) As Double
basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0#
SecondPoint(0) = 1#: SecondPoint(1) = 3#: SecondPoint(2) = 0#
Set rayObj = ThisDrawing.ModelSpace.AddRay(basePoint, SecondPoint)
' Create a polyline object in model space
Dim plineObj As AcadLWPolyline
Dim points(0 To 5) As Double
points(0) = 3: points(1) = 7
points(2) = 9: points(3) = 2
points(4) = 3: points(5) = 5
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
plineObj.Closed = True
' Create a line object in model space
Dim lineObj As AcadLine
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
endPoint(0) = 2: endPoint(1) = 2: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
' Create a circle object in model space
Dim circObj As AcadCircle
Dim centerPt(0 To 2) As Double
Dim radius As Double
centerPt(0) = 20: centerPt(1) = 30: centerPt(2) = 0
radius = 3
Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)
' Create an ellipse object in model space
Dim ellObj As AcadEllipse
Dim majAxis(0 To 2) As Double
Dim center(0 To 2) As Double
Dim radRatio As Double
center(0) = 5#: center(1) = 5#: center(2) = 0#
majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0#
radRatio = 0.3
Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)
ZoomAll
' Create a selection set
Dim ssetObj As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets.Add("WBLOCKSET")
' Iterate through the model space collection and add
' each item found to an array of objects
ReDim objsInModelSpace(0 To ThisDrawing.ModelSpace.count - 1) As AcadEntity
Dim I As Integer
For I = 0 To ThisDrawing.ModelSpace.count - 1
Set objsInModelSpace(I) = ThisDrawing.ModelSpace.Item(I)
Next
' Add the array of objects into the selection set
ssetObj.AddItems objsInModelSpace
' Output the selection set to a new file
ThisDrawing.Wblock "C:\AutoCAD\WBlock_example.dwg", ssetObj
End Sub

Sub Example_WBlock() 
    ' This example creates several objects in model space and 
    ' adds them to a selection set. This selection set is then 
    ' output as a new drawing file. 
    
    ' Create a Ray object in model space 
    Dim rayObj As AcadRay 
    Dim basePoint(0 To 2) As Double 
    Dim SecondPoint(0 To 2) As Double 
    basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0# 
 
    SecondPoint(0) = 1#: SecondPoint(1) = 3#: SecondPoint(2) = 0# 
    Set rayObj = ThisDrawing.ModelSpace.AddRay(basePoint, SecondPoint) 
    
    ' Create a polyline object in model space 
    Dim plineObj As AcadLWPolyline 
    Dim points(0 To 5) As Double 
    points(0) = 3: points(1) = 7 
    points(2) = 9: points(3) = 2 
    points(4) = 3: points(5) = 5 
 
    Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points) 
    plineObj.Closed = True 
 
    ' Create a line object in model space 
    Dim lineObj As AcadLine 
    Dim startPoint(0 To 2) As Double 
    Dim endPoint(0 To 2) As Double 
    startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0 
    endPoint(0) = 2: endPoint(1) = 2: endPoint(2) = 0 
 
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint) 
    
    ' Create a circle object in model space 
    Dim circObj As AcadCircle 
    Dim centerPt(0 To 2) As Double 
    Dim radius As Double 
    centerPt(0) = 20: centerPt(1) = 30: centerPt(2) = 0 
    radius = 3 
    Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius) 
 
    ' Create an ellipse object in model space 
    Dim ellObj As AcadEllipse 
    Dim majAxis(0 To 2) As Double 
    Dim center(0 To 2) As Double 
    Dim radRatio As Double 
    center(0) = 5#: center(1) = 5#: center(2) = 0# 
    majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0# 
    radRatio = 0.3 
    Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio) 
 
    ZoomAll 
    
    ' Create a selection set 
    Dim ssetObj As AcadSelectionSet 
    Set ssetObj = ThisDrawing.SelectionSets.Add("WBLOCKSET") 
    
    ' Iterate through the model space collection and add 
    ' each item found to an array of objects 
    ReDim objsInModelSpace(0 To ThisDrawing.ModelSpace.count - 1) As AcadEntity 
    Dim I As Integer 
    For I = 0 To ThisDrawing.ModelSpace.count - 1 
 
        Set objsInModelSpace(I) = ThisDrawing.ModelSpace.Item(I) 
    Next 
    
    ' Add the array of objects into the selection set 
    ssetObj.AddItems objsInModelSpace 
    
    ' Output the selection set to a new file 
    ThisDrawing.Wblock "C:\AutoCAD\WBlock_example.dwg", ssetObj 
    
End Sub

aeo · 发表于 2004-2-1 16:19:00

最初由 gephen 发布
[B]CopyObjects 的参数如何设置，我老是设不对
doc1 对象所在文件
doc2 目标文件
objCollection 对象集
doc1.CopyObjects (objCollection， doc2)
但我这样设后，还是出错，“CopyObjects 不能应用在IAcadDocumen... [/B]

我想是应该要进入modelspace,或者其他的对象中吧!
doc1.modelspace.CopyObjects (objCollection， doc2.modelspace)

"对象所在文件"还不是对象集的"上级"

kfygl · 发表于 2004-2-3 23:29:24

如果要求实体拷贝到另一文件中后变化比例，要求图形变大或变小时，用VBA如何实现？

账号		自动登录	找回密码
密码			立即注册

[求助]：如何将选中的实体保存到另一个文件？

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子