PhilBat

Bonjour dans une boucle For Each je teste le nom des blocs sélectionnés Est-il possible d'avoir accès à différente position dans une "idArray" je voudrais en faite tester deux noms de blocs qui se suivent dans la variable idarray (par exemple) Dim filList(0) As TypedValue filList.SetValue(New TypedValue(DxfCode.Start, "INSERT"), 0) Dim filter As SelectionFilter = New SelectionFilter(filList) Dim res As PromptSelectionResult = ed.GetSelection(filter) Dim acSSet As SelectionSet = res.Value Dim idArray() As ObjectId = acSSet.GetObjectIds For Each blkId As ObjectId In idArray Dim blkRef As BlockReference = CType(tr.GetObject(blkId, OpenMode.ForRead), BlockReference) if blkref.name ="TOTO" then ... teste du bloc suivant ... end if Next Comment Faire ? Merci Phil

Cool Merci Gile

Bonjour, je désire inserer à différent endroit de l'écran (AutoCAD) un texte en utilisant le code suivant : Dim doc As Document = AcApp.DocumentManager.MdiActiveDocument Dim db As Database = doc.Database Dim ed As Editor = doc.Editor Using Tr As Transaction = db.TransactionManager.StartTransaction '' Open the Block table for read Dim acBlkTbl As BlockTable acBlkTbl = Tr.GetObject(db.BlockTableId, OpenMode.ForRead) '' Open the Block table record Model space for write Dim acBlkTblRec As BlockTableRecord acBlkTblRec = Tr.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite) Do ' --- insertion texte Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "Point d'insertion du texte: ") If (ppr.Status <> PromptStatus.OK) Then GoTo Fin End If Dim acText As DBText = New DBText() acText.SetDatabaseDefaults() acText.Position = New Point3d(ppr.Value.X, ppr.Value.Y, 0.0#) acText.TextString = txtCmp.Text acBlkTblRec.AppendEntity(acText) Tr.AddNewlyCreatedDBObject(acText, True) Loop Fin: Tr.Commit() End Using Le problème est que le texte n'apparait qu'a la fin. Je voudrais voir s'inserer le texte à fur et à mesure des points d'insertions. comment faire ? Merci d'avance Phil.

Ok Merci Gile Pourquoi se compliquer la vie, quand on peut faire simple.... A+

Bonjour, après recherche sur internet, j'avais trouvé ce code pour désactiver la croix dans une fenêtre FORM : Public Class DisableCroix Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Integer Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Integer, ByVal bRevert As Boolean) As Integer Public Const MF_BYPOSITION = &H400& Public Const MF_REMOVE = &H1000& Public Sub New(ByVal hwnd As Integer, ByVal sText As String, ByVal IDMenu As Short) Dim hSysMenu As Integer Dim nCount As Integer '*/ Pour désactiver la croix system----------- hSysMenu = GetSystemMenu(hwnd, False) nCount = GetMenuItemCount(hSysMenu) RemoveMenu(hSysMenu, nCount - 1, MF_REMOVE Or MF_BYPOSITION) RemoveMenu(hSysMenu, nCount - 2, MF_REMOVE Or MF_BYPOSITION) End Sub End Class Private Sub frm_load(....)handles Mybase.load DisCroix = New DisableCroix(Me.Handle.ToInt32, "", 0) End Sub Apprès adaptation pour AutoCAD 2013 Celui me provoque une erreur en mode déboguage uniquement : PInvokeStackImbalance a été détecté Message: Un appel à la fonction PInvoke 'Affaire!Affaire.DisableCroix::GetMenuItemCount' a déséquilibré la pile. Cela peut se produire, car la signature PInvoke managée ne correspond pas à la signature cible non managée. Vérifiez que la convention d'appel et les paramètres de la signature PInvoke correspondent à la signature non managée cible. Ce message n'existait pas avec autoCAD 2011. Merci d'avance pour vos idées ... Phil

Bonjour, a partir d'un bloc existant dans un dessin DWG je dois tester l'existance de l'attribut "REP", si celui-ci existe je modifie sa valeur (tagstring). Jusque là ... je sais faire. Par contre, si l'attribut n'existe pas je dois rajouter celui-ci avec paramétrage de couleur, calque, position, visibilité... Je dois faire ceci pour trois attributs différents (REP,PUIS,ARM). Leurs points d'insertions seront basés par rapport au point d'insertion du bloc avec des valeurs DeltaX, DeltaY en plus (déterminées au préalable). et tout cela en vb.net Merci d'avance pour vos idées a+ Philippe

Ca ne marche pas : toujours le message d'erreur 'Dessin en cours !' voici le code : Imports Autodesk.AutoCAD.Runtime Imports Autodesk.AutoCAD.ApplicationServices Public Class Affaire <CommandMethod("Affaire")> _ Public Sub Affaire() Dim fs, fs1 fs = CreateObject("Scripting.FileSystemObject") fs1 = CreateObject("Scripting.FileSystemObject") Dim WinAff As New frmAff() Application.ShowModalDialog(WinAff) If TemDel Then FermDWG(NameSch) fs.DeleteFile(PathAff & NameSch & ".dwg") If TemLsp Then fs1.DeleteFile(PathAff & NameLSP & ".lsp") End If End Sub End Class Une fois Winaff terminée, si TemDel est 'True', il faut fermer le dessin en cours et l'effacer, mais FermDWG provoque l'erreur Je ne sais plus quoi faire ... A+ Phil.

Bonjour, j'ai testé CloseAndDiscard() suivant ta solution Gile. Mais apparement, il faut une fenêtre en 'modeless' pour que cela fonctionne. J'aurait besoin d'une solution en "modal" Merci A+

Bonjour, malgré x tentative de programmation je n'arrive toujours pas à fermer un document courant à partir d'une fenêtre de dialogue (modal) créer sous vb 2010 cela me provoque une erreur "eDocumentSwitchDisabled" Voici un extrait de code où se produit l'erreur : Public Sub FermDWG(ByVal d As String) Dim acDocMgr As DocumentCollection = Application.DocumentManager Dim acDoc As Document = acDocMgr.MdiActiveDocument ' un seul drawing ?? If acDocMgr.Count = 1 Then '' Create a new drawing Dim acNewDoc As Document = acDocMgr.Add("sch_genpro.dwt") '' Set the new document current acDocMgr.MdiActiveDocument = acNewDoc GoTo Sk01 End If ' activation autre drawing que 'd' For Each doc As Document In acDocMgr If doc.Name <> PathAff & d & ".dwg" Then acDocMgr.MdiActiveDocument = doc Exit For End If Next Sk01: ' fermeture drawing 'd' For Each doc1 As Document In acDocMgr If doc1.Name = PathAff & d & ".dwg" Then doc1.CloseAndDiscard() End If Next End Sub Merci d'avance Phil

Bonjour, à partir de visual basic 2010 (VB NET), je désire sélectionner une fenetre (créer au préalable par fmult) dans l'espace papier. Récupérer ses propriétés dans le but de pouvoir modifier l'échelle de la fenêtre (par exemple). Merci de votre aide a+ Phil

Bonjour, merci pour vos réponses il est difficile pour moi de vous indiquer le code correspondant à WinDistrib (code assez conséquent) mais se résume par l'insertion de bloc via Getpoint, des modification d'attributs, des manipulations de combobox/textbox/checkbox/radiobutton/MsgBox.... rien d'extraordinaire Lors de contrôle sur autoCAD j'utilise souvant : Using Tr As Transaction = Db.TransactionManager.StartTransaction() Dim bt As BlockTable = DirectCast(Tr.GetObject(Db.BlockTableId, OpenMode.ForRead), BlockTable) Dim btr As BlockTableRecord = DirectCast(Tr.GetObject(Db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord) .... Tr.Commit() End Using Je ne suis pas sûr que cela peut vous aider ... plus Autre chose : le code Application.ShowModalDialog(winDistrib) n'est pas reconnu... aahhh oui il manque : Imports Autodesk.AutoCAD.ApplicationServices A+ Phil

Bonjour à tous, à chaque fois que je lance une commande qui à été créée avec visual basic 2010 (VB NET) (fichier dll chargé au préalable avec netload) quand je demande la fenêtre de commande autocad (F2), celle-ci ne peut plus se retirer, pour continuer à travailler, elle reste en arrière plan. Lorsque je quitte AutoCAD, une fenêtre d'erreur avec un point d'exclamation apparait mais sans aucune autre information. est-ce lié a mon 1er problème ? Voici un exemple de code pour la création d'une commande en vb net Imports Autodesk.AutoCAD.Runtime Public Class Distribution <CommandMethod("Distribution")> _ Public Sub Distribution() Dim WinDistrib As New frmDistrib() WinDistrib.ShowDialog() End Sub End Class Merci d'avance phil

Bonjour, à partir des coordonnées d'insertion d'un bloc (BlkRef.position.X,...) qui pour moi sont définies en coordonnées SCG (à confirmer). Le but est de calculer un point avec des distances DeltaX, et DeltaY prédéfinies par rapport au bloc. Mais les choses se compliquent quand les coordonnées ne sont pas SCG le code suivant ne marche pas : Using br As New BlockReference(Point3d.Origin, bt(blockName)) br.TransformBy(Matrix3d.Displacement(Ins - Point3d.Origin).PreMultiplyBy(ed.CurrentUserCoordinateSystem)) btr.AppendEntity(br) Tr.AddNewlyCreatedDBObject(br, True) ...... Ins correspond à blkRef = CType(Tr.GetObject(blkId, OpenMode.ForRead), BlockReference) InsertPnt = New Point3d(blkRef.Position.X, blkRef.Position.Y, 0.0#) Ins = New Point3d(InsertPnt.X + CDbl(txtDeltaX.Text), InsertPnt.Y + CDbl(txtDeltaY.Text), InsertPnt.Z) Cela me calculs des coordonnées qui ne sont pas en phase avec le SCU Comment peut-on les transformées en coordonnées SCU courant ? Merci Phil.

Bonjour, voilà, à la suite d'une sélection d'objets (ligne, bloc, polyligne ...) je voudrais lister leur "nom" dans une listbox. Et pouvoir les copier ou déplacer dans un autre calque (indiqué dans une textbox par ex) Merci d'avance Phil

Salut Gile Merci pour tout Tu es vraiment trop fort. B) Existe t-il un livre pour en savoir plus sur la prog. vb net avec autoCAD ? a+ Phil

Oui pour les filtres mais il est facile de les créer quand on sait d'avance les calques concernés ce qui n'est pas mon cas : d'un dwg à l'autre je n'ai pas la même chose (le nombre de calque peut varier). Il faut que je les traite dans l'ordre croissant. Je doute que le code suivant me donne un listing qui respecte cela : Using Tr As Transaction = Db.TransactionManager.StartTransaction Dim acLyrTbl As LayerTable acLyrTbl = Tr.GetObject(Db.LayerTableId, OpenMode.ForRead) For Each acObjId As ObjectId In acLyrTbl Dim acLyrTblRec As LayerTableRecord acLyrTblRec = Tr.GetObject(acObjId, OpenMode.ForRead) If acLyrTblRec.Name = "1" Then .......... End If Next End Using Il faut que le programme s'adapte. Pardon pour le goto, il faut absolument le retirer des commandes de vs2010... :blink: nota: le nom des calques peut varier de "1","2","3" à l'infini.

Bonjour à tous à partir d'une sélection d'objets (selectall) je voudrai créer une autre sélection répondant à quelques critères (calque) qui au final me permet de créer un bloc sur le disque dur. :unsure: Voici un exemple de code : Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument Dim ed As Editor = acDoc.Editor Dim Db As Database = acDoc.Database Dim idArray() As ObjectId 'Dim blkRef As BlockReference Dim TemSsetObj As SelectionSet Dim acObjId As ObjectId Using Tr As Transaction = Db.TransactionManager.StartTransaction Dim res As PromptSelectionResult = ed.SelectAll() Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection() If (res.Status <> PromptStatus.OK) Then ed.WriteMessage(vbLf & "Failed to select all entity [Lg..-prmfolio]") GoTo Fin End If Dim acSSet As SelectionSet = res.Value For I = 0 To UBound(Calque) If Not TemForcSuf Then txtSuffixe.Text = Calque(I) For Each acObjId In acSSet.GetObjectIds() Dim acEnt As Entity = Tr.GetObject(acObjId, OpenMode.ForRead) If Not IsDBNull(acEnt) Then If Microsoft.VisualBasic.Right("00" & acEnt.Layer, 3) = Calque(I) Or (acEnt.Layer = "FDP" And Calque(I) <> "PDG") Then acObjIdColl.Add(acObjId) End If End If Next ThisDrawing.Wblock(PathAff & "\" & Trim(txtPrefixe.Text) & Trim(txtRacine.Text) & "_" & Trim(txtSuffixe.Text) & ".dwg", ????????) acObjIdColl.Clear() If TemForcSuf Then txtSuffixe.Text = IncNum(txtSuffixe.Text, 1) Next Tr.Commit() Fin: End Using Me.Close() End Sub nota: la variable 'Calque' est la liste des calques triés numériquement (calque '1' puis '2' ...etc) Suivant le lien http://docs.autodesk.com/ACD/2010/ENU/AutoCAD%20.NET%20Developer%27s%20Guide/index.html il faut utilisé une collection pour travailler avec plusieurs sélections. Mais au final j'ai besoin d'une sélection pour créer mon bloc et pas d'une collection. Comment faire ? :( Merci Phil.

Merci pour ces informations, indispensables pour moi, car il est vrai que sans ce forum il me serait très difficile de mettre en oeuvre mon programme. La documentation sur ce sujet (vb net pour autocad) est assez "lite" en générale. Même Autodesk donne quelques exemples mais n'aborde pas tous les cas de figure Concernant mon accès au dwg depuis une fenêtre "form" (modeless), j'avais compris qu'il fallait verrouiller le DWG puis utiliser "les commandes autocad (acedcommand)", cela ne marchais pas malgré toutes tentatives. Gile, Ta dernière solution marche enfin... :D B) .... ouf Mais je ne suis pas au bout de mes peines, j'ai encore du travail à faire pour finaliser mon programme. a+ Phil

Bonjour, après X essais, je n'arrive toujours pas à mettre en oeuvre une commande synchrone avec AutoCAD à partir d'une fenêtre form en modeless. le but c'est de créer : - un calque "-GpO_parcours" si nécessaire - une poligne (avec 5 points max.) - inserer un bloc sur ces points (avec attribut de valeur 1 à 5). Voici le code : Dim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument Dim ed As Editor = acDoc.Editor Dim Db As Database = acDoc.Database Dim AcCalque As String If PtRefX(0) = 0 Then Exit Sub ' mémo calque courant AcCalque = ThisDrawing.Application.ActiveDocument.ActiveLayer.Name Using lockDoc As DocumentLock = acDoc.LockDocument() '' verrouille le document Using Tr As Transaction = Db.TransactionManager.StartTransaction() '' Open the Layer table for read Dim acLyrTbl As LayerTable acLyrTbl = Tr.GetObject(Db.LayerTableId, OpenMode.ForRead) Dim sLayerName As String = "-GpO_Parcours" If acLyrTbl.Has(sLayerName) = False Then Dim acLyrTblRec As LayerTableRecord = New LayerTableRecord() '' Assign the layer the ACI color 1 and a name acLyrTblRec.Color = Color.FromColorIndex(ColorMethod.ByAci, 1) acLyrTblRec.Name = sLayerName '' Upgrade the Layer table for write acLyrTbl.UpgradeOpen() '' Append the new layer to the Layer table and the transaction acLyrTbl.Add(acLyrTblRec) Tr.AddNewlyCreatedDBObject(acLyrTblRec, True) End If '' Set the layer -GpO_Parcours current Db.Clayer = acLyrTbl(sLayerName) If PtRefX(0) <> 0 And PtRefY(0) <> 0 And PtRefX(1) <> 0 And PtRefY(1) <> 0 And _ PtRefX(2) <> 0 And PtRefY(2) <> 0 And PtRefX(3) <> 0 And PtRefY(3) <> 0 And _ PtRefX(4) <> 0 And PtRefY(4) <> 0 And PtRefX(5) <> 0 And PtRefY(5) <> 0 Then TemPoly = True EffPtRefDess() Pinvoke.Command("_pline", New Point3d(PtRefX(0), PtRefY(0), 0.0#), New Point3d(PtRefX(1), PtRefY(1), 0.0#), _ New Point3d(PtRefX(2), PtRefY(2), 0.0#), New Point3d(PtRefX(3), PtRefY(3), 0.0#), _ New Point3d(PtRefX(4), PtRefY(4), 0.0#), New Point3d(PtRefX(5), PtRefY(5), 0.0#)) End If If PtRefX(0) <> 0 And PtRefY(0) <> 0 And PtRefX(1) <> 0 And PtRefY(1) <> 0 And _ PtRefX(2) <> 0 And PtRefY(2) <> 0 And PtRefX(3) <> 0 And PtRefY(3) <> 0 And _ PtRefX(4) <> 0 And PtRefY(4) <> 0 And PtRefX(5) = 0 And PtRefY(5) = 0 Then TemPoly = True EffPtRefDess() Pinvoke.Command("_pline", New Point3d(PtRefX(0), PtRefY(0), 0.0#), New Point3d(PtRefX(1), PtRefY(1), 0.0#), _ New Point3d(PtRefX(2), PtRefY(2), 0.0#), New Point3d(PtRefX(3), PtRefY(3), 0.0#), _ New Point3d(PtRefX(4), PtRefY(4), 0.0#)) End If If PtRefX(0) <> 0 And PtRefY(0) <> 0 And PtRefX(1) <> 0 And PtRefY(1) <> 0 And _ PtRefX(2) <> 0 And PtRefY(2) <> 0 And PtRefX(3) <> 0 And PtRefY(3) <> 0 And _ PtRefX(4) = 0 And PtRefY(4) = 0 And PtRefX(5) = 0 And PtRefY(5) = 0 Then TemPoly = True EffPtRefDess() Pinvoke.Command("_pline", New Point3d(PtRefX(0), PtRefY(0), 0.0#), New Point3d(PtRefX(1), PtRefY(1), 0.0#), _ New Point3d(PtRefX(2), PtRefY(2), 0.0#), New Point3d(PtRefX(3), PtRefY(3), 0.0#)) End If If PtRefX(0) <> 0 And PtRefY(0) <> 0 And PtRefX(1) <> 0 And PtRefY(1) <> 0 And _ PtRefX(2) <> 0 And PtRefY(2) <> 0 And PtRefX(3) = 0 And PtRefY(3) = 0 And _ PtRefX(4) = 0 And PtRefY(4) = 0 And PtRefX(5) = 0 And PtRefY(5) = 0 Then TemPoly = True EffPtRefDess() Pinvoke.Command("_pline", New Point3d(PtRefX(0), PtRefY(0), 0.0#), New Point3d(PtRefX(1), PtRefY(1), 0.0#), _ New Point3d(PtRefX(2), PtRefY(2), 0.0#)) End If If PtRefX(0) <> 0 And PtRefY(0) <> 0 And PtRefX(1) <> 0 And PtRefY(1) <> 0 And _ PtRefX(2) = 0 And PtRefY(2) = 0 And PtRefX(3) = 0 And PtRefY(3) = 0 And _ PtRefX(4) = 0 And PtRefY(4) = 0 And PtRefX(5) = 0 And PtRefY(5) = 0 Then TemPoly = True EffPtRefDess() Pinvoke.Command("_pline", New Point3d(PtRefX(0), PtRefY(0), 0.0#), New Point3d(PtRefX(1), PtRefY(1), 0.0#)) End If If PtRefX(0) <> 0 And PtRefY(0) <> 0 Then Pinvoke.Command("-i", "PointBase.dwg", New Point3d(PtRefX(0), PtRefY(0), 0.0#), 5, 5, 0) For I = 1 To 5 If PtRefX(I) <> 0 And PtRefY(I) <> 0 Then Pinvoke.Command("-i", "Pointref.dwg", New Point3d(PtRefX(I), PtRefY(I), 0.0#), 5, 5, 0, I.ToString) End If Next End If Db.Clayer = acLyrTbl(AcCalque) Tr.Commit() End Using ThisDrawing.Application.Update() End Using Mais je ne vois rien sur l'écran de autocad même une fois la fenêtre form quitter. Merci à tous nota: la routine 'EffPtRefDess' efface toutes les entitées du calque '-GpO_Parcours' Phil

Bonjour Comment avoir accès en VB NET au 'nom' de tous les dessins ouverts dans AutoCAD. Merci Phil.

La routine dévelloppée sous VS2010 fait apparaitre une fenêtre (FORM). à partir d'un bouton de celle-ci (ou tout autre moyen), je veux commuter sur AutoCAD qui est lui aussi en exécution (celle lui qui lance ma routine) pour éventuellement faire des zooms afin de vérifier de visu le contenu du dessin courant. Une fois fini, je veux avoir la possibilité de revenir dans la fenêtre de ma routine (qui était toujours visible et en attente) Voici le code en VBA qui illustre la manière pour l'évènement click du bouton Private Sub tglPlan_Click() If tglPlan.Value Then frmPuis.Hide frModal = Not (tglPlan.Value) If frModal Then frmPuis.Show (vbModal) Else frmPuis.Show (vbModeless) End If End If End Sub je voudrai pouvoir en faire autant sous vb net Je sais pas si cela est suffisant pour éclaicir mon problème. Phil.

Salut Oui c'est bien une application pour AutoCAD (Création d'un fichier dll et chargement avec netload dans AutoCAD). Etant débutant dans VB NET, j'éprouve des difficultés de mise en oeuvre de ta réponse pour les commandes synchrone VB -> AutoCAD une commande simple de fermeture du dessin courant me provoque une erreur comme quoi le dessin est en court d'utilisation Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.CloseAndDiscard() Donc je cherche d'autre moyen d'agir directement sur autoCAD. a+ Phil

Bonjour à tous, je voudrais à partir d'un programme crée avec VS2010 (fichier dll) avoir accès temporairement au contenu du dessin DWG courant (faire des zooms par ex.) et revenir à mon programme (en cliquant sur la fenêtre). Autre problème. Comment executer des commandes en synchrone dans AutoCAD (comprends rien sur la mise en application de la méthose Acedcommand). A bientôt Phil.

Rebonjour, Merci Bruno pour le résumé de mon problème car c'est exactement ça. Je constate un inconvéniant sur l'utilisation d'un réacteur, il désactive les poignées dans la sélection quelque soit la commande. La touche suppr n'efface plus les blocs filtrés mais le bouton 'effacer' de la barre d'outils les efface encore. bref c'est pas gagné a+ Phil

Bonjour, Merci pour ta réponse Cela m'inspire effectivement C'est assez complexe pour moi. Mais dois-je intégrer ce code dans 'acaddoc.lsp' par exemple, avec adaptation de la ligne. a+ Phil