ci joint un prog qui marche je te joint le fichier bloc bp.dwg qu'il demandra.
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Windows
Imports Autodesk.AutoCAD.LayerManager.LayerFilter
Imports Autodesk.AutoCAD.EditorInput
Imports System.IO
Imports Autodesk.AutoCAD.Geometry
Public Class Class1
' Define command 'Asdkcmd1'
<CommandMethod("ImpBloc")> _
Public Sub ImpBloc()
'implanter un bloc Bp
Dim DB As Database = HostApplicationServices.WorkingDatabase
Dim ed As Editor
ed = Application.DocumentManager.MdiActiveDocument.Editor
Dim trans As Transaction
trans = DB.TransactionManager.StartTransaction
'récupération de la table des block
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim btr As BlockTableRecord
btr = trans.GetObject(bt.Item(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Dim id As ObjectId
If bt.Has("bp") Then
'non trouvé
Dim btrSrc As BlockTableRecord
btrsrc=trans.GetObject(bt.Item("BP"), OpenMode.ForRead)
id = btrSrc.Id
Else
'pas trouvé donc ajout !
Dim Dbdwg As New Database(False, True)
Dbdwg.ReadDwgFile("d:\autocad\bloc.dwg\bp.dwg", FileOpenMode.OpenTryForReadShare, True, "")
id = DB.Insert("bp", Dbdwg, False)
Dbdwg.Dispose()
End If
'Ici nous avons le ID du bloc (définition)
'insertion :
Dim opPt As New PromptPointOptions("Sélectionnez un point")
Dim resPt As PromptPointResult
resPt = ed.GetPoint(opPt)
Dim ptInsert As Point3d = Nothing
Dim blkRef As BlockReference
If resPt.Status = PromptStatus.OK Then
ptInsert = resPt.Value
blkRef = New BlockReference(ptInsert, id)
btr.AppendEntity(blkRef)
trans.AddNewlyCreatedDBObject(blkRef, True)
' modify the attribute of the block reference
Dim btAttRec As BlockTableRecord
btAttRec = trans.GetObject(id, OpenMode.ForRead)
Dim idAtt As ObjectId
For Each idAtt In btAttRec
Dim ent As Entity
ent = trans.GetObject(idAtt, OpenMode.ForRead)
If TypeOf ent Is AttributeDefinition Then
Dim attDef As AttributeDefinition
attDef = CType(ent, AttributeDefinition)
Dim attRef As New AttributeReference()
attRef.SetAttributeFromBlock(attDef, blkRef.BlockTransform)
'Dim ptBase As New Point3d(blkRef.Position.X + attDef.Position.X, blkRef.Position.Y + attDef.Position.Y, blkRef.Position.Z + attDef.Position.Z)
'attRef.Position = ptBase
'attRef.Rotation = attDef.Rotation
'attRef.Tag = attDef.Tag
attRef.TextString = "input your data here"
'attRef.Height = attDef.Height
'attRef.FieldLength = attDef.FieldLength
Dim idTmp As ObjectId
idTmp = blkRef.AttributeCollection.AppendAttribute(attRef)
trans.AddNewlyCreatedDBObject(attRef, True)
End If
Next
trans.Commit()
Else
MsgBox("Point introuable !")
trans.Abort()
End If
''
'If myBlock.XrefStatus = XrefStatus.NotAnXref And _
' myBlock.IsLayout = False And _
' myBlock.IsAnonymous = False Then
' Select Case pStrRes.StringResult
' Case "Oui"
' clAcpBlocks.EchelleUniforme(HostApplicationServices.WorkingDatabase, myBlock.Name, True)
' Case "Non"
' clAcpBlocks.EchelleUniforme(HostApplicationServices.WorkingDatabase, myBlock.Name, False)
' End Select
'End If
End Sub
pour débugger il te suffira de lancer l'application en clikant sur RUN il chargera le dll je crois sinon tu le charges manuellement puis tu lances la commande ImpBloc
a+
