Hi, Babak
I hope it can help you
Imports AcAp = Autodesk.AutoCAD.ApplicationServices
Imports AcEd = Autodesk.AutoCAD.EditorInput
Imports AcGe = Autodesk.AutoCAD.Geometry
Imports AcRx = Autodesk.AutoCAD.Runtime
Imports AcDb = Autodesk.AutoCAD.DatabaseServices
Public Module Module1
_
Public Sub Copy2Layer()
Dim ed As AcEd.Editor =
AcAp.Application.DocumentManager.MdiActiveDocument.Editor()
ed.WriteMessage(vbLf & "Copy entities to layer")
Dim res As AcEd.PromptEntityResult = ed.GetEntity("Select entity")
If res.Status <> AcEd.PromptStatus.OK Then Exit Sub
Dim optp As New AcEd.PromptPointOptions(vbLf & "Copy from point")
Dim resp As AcEd.PromptPointResult = ed.GetPoint(optp)
If resp.Status <> AcEd.PromptStatus.OK Then Exit Sub
Dim fromPt As AcGe.Point3d = resp.Value
optp.Message = "To point"
optp.UseBasePoint = True
optp.BasePoint = fromPt
resp = ed.GetPoint(optp)
If resp.Status <> AcEd.PromptStatus.OK Then Exit Sub
Dim toPt As AcGe.Point3d = resp.Value
Dim id As AcDb.ObjectId = Module1.CopyEntity(res.ObjectId, fromPt,
toPt)
Module1.ChangeLayer(id, "NewLayer")
End Sub
Friend Function CopyEntity(ByVal objID As AcDb.ObjectId, ByVal fromPt
As
AcGe.Point3d, ByVal toPt As AcGe.Point3d) As AcDb.ObjectId
If objID = Nothing Then Return Nothing
Dim id As AcDb.ObjectId = Nothing
Using db As AcDb.Database =
AcDb.HostApplicationServices.WorkingDatabase()
Using tr As AcDb.Transaction =
db.TransactionManager.StartTransaction
Try
Dim v3d As New AcGe.Vector3d(toPt.X - fromPt.X, toPt.Y -
fromPt.Y, toPt.Z - fromPt.Z)
Dim m3d As AcGe.Matrix3d = AcGe.Matrix3d.Displacement(v3d)
Using btr As AcDb.BlockTableRecord =
tr.GetObject(db.CurrentSpaceId, AcDb.OpenMode.ForWrite, False)
Dim ent As AcDb.Entity = tr.GetObject(objID,
AcDb.OpenMode.ForRead, False)
Dim e As AcDb.Entity = ent.GetTransformedCopy(m3d)
id = btr.AppendEntity(e)
db.TransactionManager.AddNewlyCreatedDBObject(e, True)
tr.Commit()
End Using
Catch ex As Exception
tr.Abort()
End Try
End Using
End Using
Return id
End Function
Friend Sub ChangeLayer(ByVal objID As AcDb.ObjectId, ByVal newLayer As
String)
'Dim dl As AcAp.DocumentLock =
AcAp.Application.DocumentManager.MdiActiveDocument.LockDocument()
Using db As AcDb.Database =
AcDb.HostApplicationServices.WorkingDatabase()
Using tr As AcDb.Transaction =
db.TransactionManager.StartTransaction()
Dim ent As AcDb.Entity = tr.GetObject(objID,
AcDb.OpenMode.ForWrite)
ent.Layer = newLayer
tr.Commit()
End Using
End Using
'dl.Dispose()
End Sub
End Module
tp
escreveu na mensagem news:5385306@discussion.autodesk.com...
?Thank you very much for your answer, but this code cuts the selected
object
and move it to NewLayer. I want to Copy it and have a copy of that object
to
another layer. Would you help me with this?
Thank you,
Babak
I'm protected by SpamBrave
http://www.spambrave.com/