Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Windows
Imports AXDBLib
<CommandMethod("SingleCopy")> _
Public Sub SingleCopy()
Dim AcadApp As AutoCAD.AcadApplication = GetObject(, "Autocad.Application")
Dim fname As String = "D:\Active Systems\Блоки\Версия первая.dwg"
' This example creates a Circle object and uses the CopyObjects
' method to make a copy of the new Circle.
Dim DOC1 As AutoCAD.AcadDocument
Dim circleObj1 As AcadCircle, circleObj2 As AcadCircle
Dim circleObj1Copy As AcadCircle, circleObj2Copy As AcadCircle
Dim centerPoint(0 To 2) As Double
Dim radius1 As Double, radius2 As Double
Dim radius1Copy As Double, radius2Copy As Double
Dim objCollection(0 To 1) As Object
Dim retObjects As Object
' Define the Circle object
centerPoint(0) = 0 : centerPoint(1) = 0 : centerPoint(2) = 0
radius1 = 5.0# : radius2 = 7.0#
radius1Copy = 1.0# : radius2Copy = 2.0#
' Create a new drawing
DOC1 = AcadApp.ActiveDocument
' Add two circles to the drawing
circleObj1 = DOC1.ModelSpace.AddCircle(centerPoint, radius1)
circleObj2 = DOC1.ModelSpace.AddCircle(centerPoint, radius2)
AcadApp.ZoomAll()
' Copy objects
'
' First put the objects to be copied into a form compatible with CopyObjects
objCollection(0) = circleObj1
objCollection(1) = circleObj2
' Copy object and get back a collection of the new objects (copies)
retObjects = DOC1.CopyObjects(objCollection, DOC1.ModelSpace)
' Get newly created object and apply new properties to the copies
circleObj1Copy = retObjects(0)
circleObj2Copy = retObjects(1)
circleObj1Copy.Radius = radius1Copy
circleObj2Copy.Radius = radius2Copy
AcadApp.ZoomAll()
MsgBox("Circles copied.")
End Sub
End Class