dr.loveless

Voilà la solution que j'ai élaboré : For Each Present In ThisDrawing.Layouts NomPres = Present.Name Set MECA = ThisDrawing.Layouts(NomPres) For Each elem In MECA.Block If elem.EntityType = acBlockReference Then If elem.Name = "03-Cartouche A4-A3-direct" Then elem.Delete End If End If Next Next Si quelqu'un à uine méthode plus simple, je suis preneur.

Merci, çà me donne çà comme code : For Each ObjBlo In ThisDrawing.Blocks ' Supprime tous les objets du bloc If ObjBlo.Name = "03-Cartouche A4-A3-direct" Then For Each elem In ThisDrawing.Blocks.Item("03-Cartouche A4-A3-direct") elem.Delete Next elem End If Next ObjBlo For Each elem In ThisDrawing.ModelSpace 'Supprime les bloc de l'espace Objet If elem.EntityType = acBlockReference Then If elem.Name = "03-Cartouche A4-A3-direct" Then elem.Delete End If End If Next For Each elem In ThisDrawing.Paperspace ' Supprime les blocs de l'espace papier If elem.EntityType = acBlockReference Then If elem.Name = "03-Cartouche A4-A3-direct" Then elem.Delete End If End If Next Next Donc jusque là çà fonctionne à un détail pres, c'est à dire que çà me supprime uniquement le(s) bloc(s) de la dernière présentation selectionnée. Il faudrait donc que çà me fasse la même chose pour TOUTES les présentations qui sont dans le dessin, et j'y arrive pas, enfin pour l'instant. Je pense qu'il faut faire une boucle me detectant toute les présentation et repeter ainsi le code: For Each Present In ThisDrawing.Layouts NomPres = Present.Name Set MECA = ThisDrawing.Layouts.Item(NomPres) For Each elem In MECA ---le code next -> ne fonctionne pas Quelqu'un sait pourquoi ??

Salut, dans la suite de mes 2 précédent post, je cherche à supprimer tousles bloc portant un certain nom. Pour celà, j'ai fait le code suivant : Dim blkColl As AcadBlocks Dim BlocC As AcadBlock Set blkColl = ThisDrawing.Blocks For Each BlocC In blkColl If BlocC.Name = "Nom du Bloc" Then MsgBox "Un bloc de ce nom existe déjà, il va être supprimée" BlocC.Delete -> plante "Objet référencé" End If Next Il me detecte bien si'il y a déjà un bloc de ce nom, mais plante quand je lui demande de le supprimé??? BlocC.delete ?? Il me marque "Objet referencé". Je comprends pas, pourtant je fais eactement la même chose pour les présentations et çà marche nikel

La réponse à ma question : Set MECA = ThisDrawing.Layouts.Item("MECAP") Quand on veut, on pneu chez michelin !!

Salut, comment dois-je faire pour attribuer une certaine présentation dont je connais le nom à une variable ?? Set MECA = ThisDrawing.Layouts.Add("MECAP") Set objCartouche = MECA.Block.InsertBlock(PtInsert, "R:\0-DAO-Gestion\Cartouches\03-Cartouche A4-A3-direct.dwg", 1, 1, 1, 0) Le code ci-dessus permet d'ajouter une présentation et d'y insérer un cartouche, maintenant je voudrais pouvoir insérer le cartouche dans une présentation déjà existante nommée "MECAP". Merci

Merci, et tant pis pour le bisous, je le garde pour moi pour une prochaine utilisation

Salut à tous et Bonne année ! Je cherche à insérer un bloc dans une Présentation sans avoir à activer cell-ci et qui est créer depuis un code et j'y arrive po !! Et çà m'ENERVE !!!!!!!!!! dim MECA as object Set MECA = ThisDrawing.Layouts.Add("MECA") ( création dune nouvelle présentation nommée "MECA") Set objCartouche = MECA.InsertBlock(PtInsert, "R:\0-DAO-Gestion\Cartouches\03-Cartouche A4-A3-direct.dwg", 1, 1, 1, 0) he ben çà marche po, bouhouhouh .......... Un p'tit coup de main ?? merci Je précise : Je suis dans l'espace Objet et je ne veux pas rendre la présentation que j'ai crée active. Par conséquent, je veux créer une nouvelle présentation, puis y inserer un cartouche. Ensuite quand j'aurais fini mon dessin, je veux pourvoir aller dans la présentaion MECA et faire la mise en page avec la boite de dialogue qui s'affiche automatiquement quand on va dans une présentation où la config de d'impression n'a pas été choisie! Bisous à tous< [Edité le 10/1/2005 par dr.loveless]

La commande ThisDrawing.SetVariable "CMLSCALE", 100 fait que l'echelle de la MLINE est de 100, doncquand je dessinne une MLINE sur AutoCAD apres avoir lancer le code ci-avant, l'echelle de la MLINE sera bien de 100, mais en revanche si je dessine la MLINE en question depuis un VBA l'echelle sera tjs de 1 !! Pourquoi?????

Ben c'est bien, tout çà, mais on est sur le forum " VBA et VB", en lisp je sais comment faire , mais pas en VBA !!! Revenons-en à nos moutons, quelle est le code pour changer "le multiplicateur d'echelle" d'une multiligne, sous VBA ?? J'ai chercher au moins 3 heures et rien !!!!

Impossible de trouver le code me permettant de mettre une certaine echelle à une multiligne ("l'échelle" étant la distance entre les deux lignes). Merci

Voilà le programme apres rectification, He ben j'ai rarement autant galéré, pourtant çà parait tellement clair, en fait j'étais parti sur de mauvaises bases. Merci à tous Private Sub CommandButton1_Click() Dim ObjElem As Object Dim ObjBlock As Object Dim A As Integer Dim Pt1L1 As Variant Dim Pt2L1 As Variant Dim Pt1L2 As Variant Dim Pt2L2 As Variant Dim NomBlocAncien As String Dim PtDepart(0 To 2) As Double Dim PtFin(0 To 2) As Double Dim L1 As Object Dim ModRemp As String Dim tablAttrib As Variant MoRemp = TxtRemp.Text B = 0 Test = 0 C = 0 For Each ObjElem In ThisDrawing.Blocks nbrebloc = ObjElem.Count For B = 0 To nbrebloc - 1 NomBloc = ObjElem.Item(B).Name PtInsertBloc = ObjElem.Item(B).InsertionPoint Set ObjBlock = ThisDrawing.Blocks(NomBloc) tablAttrib = ObjElem.Item(B).GetAttributes For Cptpm70 = LBound(tablAttrib) To UBound(tablAttrib) ' si vous préférez avoir la liste des étiquettes au lieu ' de leur valeur, remplacez TextString par TagString If tablAttrib(Cptpm70).TagString = "TYPE" Then TypeMod = tablAttrib(Cptpm70).TextString End If Next If TypeMod = MoRemp Then For Each objent In ObjBlock If objent.ObjectName = "AcDbLine" Then If A = 0 Then Pt1L1 = objent.StartPoint Pt1L1(0) = Pt1L1(0) + PtInsertBloc(0) Pt1L1(1) = Pt1L1(1) + PtInsertBloc(1) Pt2L1 = objent.EndPoint Pt2L1(0) = Pt2L1(0) + PtInsertBloc(0) Pt2L1(1) = Pt2L1(1) + PtInsertBloc(1) End If If A = 1 Then Pt1L2 = objent.StartPoint Pt1L2(0) = Pt1L2(0) + PtInsertBloc(0) Pt1L2(1) = Pt1L2(1) + PtInsertBloc(1) Pt2L2 = objent.EndPoint Pt2L2(0) = Pt2L2(0) + PtInsertBloc(0) Pt2L2(1) = Pt2L2(1) + PtInsertBloc(1) PtDepart(0) = (Pt1L1(0) + Pt2L1(0)) / 2 PtDepart(1) = (Pt1L1(1) + Pt2L1(1)) / 2 PtDepart(2) = 0 PtFin(0) = (Pt1L2(0) + Pt2L2(0)) / 2 PtFin(1) = (Pt1L2(1) + Pt2L2(1)) / 2 PtFin(2) = 0 Set L1 = ThisDrawing.ModelSpace.AddLine(PtDepart, PtFin) End If A = 1 + A End If Next End If A = 0 Next B Exit For Next ObjElem Unload Me End Sub

Ben en fait il s'agit de plan dejà "nettoyer", donc les seuls blocs quils restent sont ceux qui m'interresse, donc pas de filtre, le seul filtre à effectuer est par rapport à l'attribut (le "remplissage" du bloc ce fait en fonction de celui-ci). Le probleme c'est que même si l'attribut est différent, le nom du bloc peut etre le même, donc quand je cherche le milieu des deux lignes il me retourne systématiquement le milieu des deux lignes du bloc de base ( le premier crée avec le nom concerné). Par exemple : J'ai 7 blocs du même nom, mais il y en a deux dont l'attribut n'est pas celui qui m'interresse. Il me dessinera alors que 5 lignes (çà j'y arrive), mais le probleme c'est qu'il me dessinne les lignes les unes sur les autres, tjs en reliant les milieu des lignes du premiers bloc!!! Sinon, je pensais, on doit pouvoir éviter le probleme en renommant chaque bloc du plan avec un nom propre à lieu (1 bloc = 1 nom), mais alors la taille de mon dessin va considérablement augmenter non?? [Edité le 11/10/2004 par dr.loveless]

Le probleme est vraiment là : Set ObjBlock = ThisDrawing.Blocks(ObjElem.Name) Il faut que je trouve le moyen de faire le set objblock sans passer par Objelem.name car cell-ci me renvoi le nom du bloc de base!! [Edité le 8/10/2004 par dr.loveless]

Merci, en effet je pense également que le soluce passe par ObjectIDToObject, je me acharn depuis au moins 1 heure, mais rien n'y fais, je crois bien que je vais laisser, tombre, çà commence à me chauffer les oreilles! Merci encore ET pis non, j'vais insister , dois bien y avoir un moyen c dingue tout de même

OK, j'ai pigé mais d'apres ce que tu dit, si j'ai X fois un bloc du même nom, je devrais avoir X ID différentes c'est bien çà? parceque quand je fais ma boucle et qu'il me repère un bloc, j'ai integrer un MSGBOX qui m'affcihe le numéro d'ID qu'il retourne. Et bien que soit ce 3 blocs du même nom, il me retourne 3 ID différentes, donc si j'ai bien compris le probleme que tu évoques est finalement celui que j'avais au début en effectuant une recherche par nom (et là effectivement il me faisait apparaitre 3 fois de suite le même nom). En revanche il existe aussi le handle, j'ai essayer avec mais çà n'a rien donné! [Edité le 8/10/2004 par dr.loveless]

J'ai pas compris, j'y connais rien en ID!

Comprends pas pourquoi je peux pas joindre l'image ??

Salut à tous, Y a un truc que je comprends pas sur le BASIC ci dessous que je suis en train de réaliser. Il s'agit d'une application qui doit se dérouler comme suit: - Liste tous les objets du ModelSpace - Si c'est un bloc, poursuit le programme, sinon quitte l'application - Liste tous les objets contenu dans le bloc - Si un de ces objets est une ligne, en extrait les coordonnées - S'il y a au moins 2 lignes dans ce bloc, me relie d'un trait le milieu de ces deux lignes - Passe au bloc suivant Le code ci-dessous contient les 2 solutions que j'ai trouver, mais aucune ne fonctionne qomme je voudrais. Dans le premier cas, je me sers du nom du bloc. Ca fonctionne quand il n'y a qu'un bloc du même nom, si'il y en a deux, çà me relie bien les milieus des lignes, mais toujours pour le premier bloc (donc fonctionne doublement pour le premier bloc, et çà ne fonctionne pas pour le second). Il existe une solution qui ne me convient pas et qui consiste à ajouter la ligne au bloc, ainsi tous les blocs du même noms auront la fameuse ligne, mais le probleme c que cette ligne doit être dessinnée en fonction de l'attribut du bloc, et deux de même nom peuvent tres bien avoir des attributs différents. La seconde solution envisagée consiste à trouver l'ID du bloc, mais en faisant le set du bloc la boucle recherchant les ligne du bloc ne fonctionne pas!! Un casse tête quoi !! 'Boucle sur tous les objets du dessin For Each ObjElem In ThisDrawing.ModelSpace 'Vérifie si l'objet est un bloc If ObjElem.EntityType = acBlockReference Then 'Attribue le numéro ObjectID du bloc NomID = ObjElem.ObjectID 'affiche le numéro ID MsgBox NomID ' Test avec le nom du bloc Set ObjBlock = ThisDrawing.Blocks(ObjElem.Name) 'Test avec le numéro ID du bloc Set ObjBlock = ThisDrawing.ObjectIdToObject(NomID) 'Pour chaque element consaituan le bloc For Each objent In ObjBlock 'Vérifie si l'objet du bloc est une ligne If objent.ObjectName = "AcDbLine" Then If A = 0 Then Pt1L1 = objent.StartPoint Pt2L1 = objent.EndPoint End If If A = 1 Then Pt1L2 = objent.StartPoint Pt2L2 = objent.EndPoint PtDepart(0) = (Pt1L1(0) + Pt2L1(0)) / 2 PtDepart(1) = (Pt1L1(1) + Pt2L1(1)) / 2 PtDepart(2) = 0 PtFin(0) = (Pt1L2(0) + Pt2L2(0)) / 2 PtFin(1) = (Pt1L2(1) + Pt2L2(1)) / 2 PtFin(2) = 0 'dessinne une ligne entre le milieu des 2 lignes d'un bloc Set L1 = ThisDrawing.ModelSpace.AddLine(PtDepart, PtFin) End If A = 1 + A End If Next objent End If Next Cpt1 End If A = 0 Next ObjElem Unload Me End Sub [Edité le 8/10/2004 par dr.loveless] [Edité le 8/10/2004 par dr.loveless]

Désolé, sujet effacé car dans mauvais forum, voir VBA [Edité le 8/10/2004 par dr.loveless]

La pensée du jour du Doc :" :mad2: Putain je suis vraiment nul, je vais me recycler et faire vendeur de crêpes" . Ca parait si simple, mais tellement compliquer en même temps !! Et moi qui m'acharnait à faire une boucle pour tester chaque block !!! Vraiment merci beaucoup !!!

Merci je viens juste de prendre connaissance de ta soluce, mais çà devrait fonctionner

Bonjour, Dans une application je voudrais tester le nom d'un bloc afin de savoir si il existe déjà, je sais le faire en Visual Basic, mais je seche completement en Lisp. Le Nom du bloc -> BlocPorte Je pense qu'il faut executer une boucle qui compare le nom de tous les blocs du dessin avec le nom du bloc (ici BlocPorte) que je veux créer. Si qq à une idée, je suis preneur !! Merci d'avance

Bon, personne ne me comprends, pourtant celà me parait clair: Environ 150 bloc composé de chacun de 2 lignes parrallèles et 3 attributs sont DEJA sur mon dessin, je veux créer un lisp qui me permette de relier les milieus des 2 lignes d'un bloc juste en selectionnant celui-ci. la ligne crée ne doit pas faire partie du bloc. En réponse à Didier : Je sais pas si tu te souviens, mais tu m'avait fais un prog permettant de déplacer les attribut d'un bloc, et ben là c'est pour relier les deux lignes de ce bloc! OK, merci mais je devrais m'en sortir avec "nentsel" - MERCI - [Edité le 13/8/2004 par dr.loveless]

Salut, J'ai un bloc constituer de 2 lignes parallèles et de 3 attributs. Je voudrais créer un lisp qui me permette de selectionner le bloc concerne et de faire une ligne reliant les milieus des deux lignes du bloc. Comment je dois m'y prendre ?? merci!!

Merci @+