Serge

etude0, Je ne sais pas si tu extrais les données avec extractdonnees (_dataextraction). Il existe une propriété d'objet nommée Forme (effective name) qui est le nom 'dynamique' de ton bloc et qui te permettra, à défaut d'empêcher d'extraire tout, de faire des regroupement une fois rendu dans Excel Serge

bseb67 J'avais déduit que tu avait 41 ans à cause du 67 dans le nom. Oui, c'est dommage que le manège militaire ait brûlé. Le gouvernement fédéral a promi qu'il allait le faire reconstruire. On y retrouvait l'une des plus anciennes prisons de la ville de Québec (et non, je n'y ai pas résidé). Oui, on a reçu de la neige ... Un total de 558cm. Si je savais comment ajouter des photos, je montrerais le devant et l'arrière de notre maison. Pour bien s'imaginer ce que ça donne (car le vent fait empirer les choses), on a un panier de basket-ball dans la cour. Le panier est à 10 pieds et il y a environ 2 pieds de plus pour le dessus du panneau (soit disons 4 mètres). Le sommet de la butte de neige dépassait ce panneau d'environ 1 mètre. Je me suis réveillé un matin et il faisait complètement noir dans la maison. Il a fallut que j'aille dégager la neige qui bloquait les fenêtres. J'en connais un qui ne pouvait même plus sortir par la porte. Il a fallut qu'il se fasse un tunnel en transportant la neige jusqu'à dans sa baignore (et tout ceci avec photos à l'appui). Je lance l'invitation à tous. Si vous venez à Québec, me prévenir à l'avance pour que je me libère. Je vous ferai visiter ... (comme Tramber m'a promi de me faire visiter Colmar) Serge

bseb67 Je suis un "Couche normal". J'habite Québec donc 6 heures de décalage. Pour C++, un seul environnement: Visual Studio (Pro) Pour le multi-thread, je ne veux pas faire le rabat-joie mais AutoCAD n'utilise qu'un thread. Pire (ou mieux), pour gérer le multi-documents, Autodesk a inventé le concept de brins (séparation d'un fil) afin d'allouer un brin à chaque dessin. Serge

bseb67 La vraie raison vient de la façon dont les processus internes communiquent entre-eux. Il ne faut pas oublier qu'un dessin est d'abord une grosse base de données et que ce qe l'on voit à l'éran est une autre base de données distincte (écran virtuel) qui nous permet de sélectionner des objets, de la dragguer, etc. Il y a le noyau d'AutoCAD qui doit communiquer avec ses interfaces de programmation en différents langages ou avec des controles ActiveX qui doivent rouler dans des processus différents. Il y a aussi toutes la série d'événements qu'AutoCAD collecte et envoie à tous les réacteurs. Quand on commence à gratter, il est encore heureux de voir que tout soit toujours synchronisé. Lorsqu'on utilise les fonctions entxxxx, AutoCAD démarre un processus de gestion de base de données qui est incompatible aux autres méthodes, ce qui risquerait d'entrainer des objets mal fermés ou déjà ouvert par un autre processus asynchrone. On a aussi des limitations lorsqu'on ouvre des boites de dialogue en DCL. Si on pouvait mixer les méthodes, on augmenterait de façon signicatives les risques de récursions dans les processus. En C++, le code est plus près du noyau et on dispose généralement de plus de latitude. On dispose en autre d'une fonction SendStringToExecute qui permet de placer une commande de notre choix sur le dessus de la pile des processus en attente et cela permet ainsi de lancer une opération dès qu'AutoCAD est disposé à le faire. Serge

ludo07, Mon but est de donner les directions pour que les gens deviennent autonomes, donc c'est très bien vu d'améliorer le programme. La seule chose que je demande, si j'ai inscrit mon nom quelque part, il devrait rester visible. Bonne vacances, les miennes viennent de se terminer (même si je viens de me taper aujourd'hui mon 3e demi-marathons en 5 jours pour me tester dimanche prochain). Serge

ludo07 VBA répartit 4 dossiers dans un projet selon le type de code 1) AutoCAD Objets : on s'en sert beaucoup pour les réacteurs, ce qui n'est pas notre besoin. Il existe d'autres équivalent selon le logiciel utilisé. L'équivalent dans Excel est ""Microsoft Excel Objects" 2) Feuilles (Sheets) : ce sont les boites de dialogue 3) Modules: pour y placer les déclarations, les fonctions et les sous-routines. C'est l'endroit où placer le code. On y reviendra. 4) Modules de classe: pour définir des classes avec leurs méthodes et propriétés (dans les limites du VBA) Le dossier 1 existe par défaut. Pour les 3 autres, on va dans le menu Insertion puis on choisit le type de dossier. Dans notre cas, c'est Insertion -> Module. À gauche, dans l'arborescence de ton projet, tu devrais maintenant voir un dossier "Modules" avec un enfant nommée "Module1". Tu fais un double-clic dessus pour l'activer puis tu y colles le code. Serge

Pieroka Je ne crois pas qu'il existe d'autres forums où on peut parler autant de toutes sortes de choses pas rapport (ça doit causer des maux de tête au hébergeurs) mais j'entre dans le jeu quand même. Même si la solution est déjà affichée, j'aurais opté pour une autre hypothèse. Comme je suis pourri en patins à roues alignées, je pensais que c'était un jeu de rouleaux pour protéger la face de ceux qui pique une plonge en pleine face. Serge

cyrkan Dans l'éditeur de VisualLisp, déroule le menu View -> Toolbars -> Tools Dans le toolbars Tools, clique la 3e icône (symbolisant une fenêtre et un crochet bleu). Clique dessus. Cela ouvre une fenêtre . Tu peux voir ou et pourquoi tu as des erreurs. Serge [Edité le 16/8/2008 par Serge]

ludo07 Dans ton message initial, tu disais vouloir un programme en VBA et maintenant tu veux une routine qui sélectionne en AutoLISP (faute de grives on mange des merles). Quoi qu'il en soit, j'ai fait une petite routine en VBA (Note: à partir de lundi, j'aurai moins de temps) Prérequis: Avoir déjà créé un bloc nommé "PROPERTIES" dans lequel les attributs suivants existent: AREA, PERIMETER, CENTROID0 et CENTROID1. À défaut, voir la routine WriteProperties ci-après Excécution: On passe par la fonction Main (ou Toto dans la fenêtre d'exécution) Attention: L'éditeur de cette page modifie les codes [surligneur] <(or), (or)>, <(and) et (and)> [/surligneur]en pensant qu'il s'agit de balises HTML. Dans le code en jaune ci-après, j'ai intercalé une espace avant le > ou après le < selon le cas pour déjouer l'éditeur. Il faut les supprimer dans le vrai code(c'est ce qui explique les très nombreux essais et erreurs que j'ai du faire avant que l'appararence du code soit le plus fidèle possible). ' Écriture des propriétés d'objets fermés dans des blocs. ' Par Serge Camiré, 2008-08-15 Option Explicit Const PI As Double = 3.14159265358979 Type RegionProperties Perimeter As Double Area As Double Centroid(1) As Double ' Point 2D MomentOfInertia(1) As Double ' Point 2D RadiiOfGyration(1) As Double ' Point 2D ProductOfInertia As Double ' Puisque la région est 2D PrincipalDirections(2) As Double ' Point 3D PrincipalMoments(1) As Double ' Point 2D End Type Private Sub main() On Error GoTo Hell Dim Success As Boolean Dim ClosedObjects() As AcadEntity Dim Mode As AcSelect: Mode = acSelectionSetCrossing Success = GetClosedObjects(ClosedObjects, ByVal Mode) Dim RegProperties() As RegionProperties Dim Perimeter As Double Dim Area As Double Dim Centroid As Variant If Success Then Success = GetProperties(ClosedObjects, RegProperties()) If Success Then Success = WriteProperties(RegProperties()) Exit Sub Hell: Debug.Print "Erreur[" & Err.Number & "] : "; Err.Description Err.Clear End Sub Private Function WriteProperties(RegProperties() As RegionProperties) As Boolean ' Écrire les propriétés (aire, périmètre, centroid) d'une collection d'objets fermés préalablement analysée ' RegProperties: tableau des propriétés. Pour ajouter des propriétés, modifier le Type ' ATTENTION: Un bloc nommé "PROPERTIES" doit déjà exister dans le dessin et comporter les bons attributs ' Dans l'exemple, on a supposé les 4 attributs suivants: AREA, PERIMETER, CENTROID0 et CENTROID1 ' Idéalement, on devrait créer un calque spécifique pour ces blocs. Le calque serait vidé avant de ré-insérer les blocs On Error GoTo Hell WriteProperties = False Dim i As Integer Dim j As Integer Dim blockRefObj As AcadBlockReference Dim varAttributes As Variant Dim insertionPoint(0 To 2) As Double Dim unit As Long: unit = acDecimal Dim precision As Integer: precision = 3 For i = LBound(RegProperties) To UBound(RegProperties) Debug.Print "Area: " & RegProperties(i).Area, " Perimètre: " & RegProperties(i).Perimeter, _ "Centroide: " & RegProperties(i).Centroid(0); "," & RegProperties(i).Centroid(1) ' Insert the block insertionPoint(0) = RegProperties(i).Centroid(0): insertionPoint(1) = RegProperties(i).Centroid(1): insertionPoint(2) = 0 Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPoint, "PROPERTIES", 1#, 1#, 1#, 0) ' Modify attributes varAttributes = blockRefObj.GetAttributes For j = LBound(varAttributes) To UBound(varAttributes) Select Case varAttributes(j).TagString Case "AREA" ' Le tag d'un de nos attributs varAttributes(j).TextString = ThisDrawing.Utility.RealToString(RegProperties(i).Area, unit, precision) Case "PERIMETER" ' Le tag d'un de nos attributs varAttributes(j).TextString = ThisDrawing.Utility.RealToString(RegProperties(i).Perimeter, unit, precision) Case "CENTROID0" ' Le tag d'un de nos attributs varAttributes(j).TextString = ThisDrawing.Utility.RealToString(RegProperties(i).Centroid(0), unit, precision) Case "CENTROID1" ' Le tag d'un de nos attributs varAttributes(j).TextString = ThisDrawing.Utility.RealToString(RegProperties(i).Centroid(1), unit, precision) End Select Next j blockRefObj.Update Next i WriteProperties = True Exit Function Hell: Debug.Print "Erreur[" & Err.Number & "] : "; Err.Description Err.Clear WriteProperties = False End Function Private Function GetProperties(ClosedObjects() As AcadEntity, ByRef RegProperties() As RegionProperties) As Boolean ' Obtenir les propriétés (aire, périmètre, centroid) d'une collection d'objets fermés (efface les régions temporairement créées) ' ClosedObjects : /* IN */ Objets fermés ' RegProperties: tableau des propriétés. Pour ajouter des propriétés, modifier le Type On Error GoTo Hell GetProperties = False Dim regionObjects As Variant Dim regionObject As AcadRegion Dim Success As Boolean Dim i As Integer ' La méthode VBA AddRegion ignore la variable DELOBJ. Les objets originaux sont toujours préservés regionObjects = ThisDrawing.ModelSpace.AddRegion(ClosedObjects) ReDim RegProperties(UBound(regionObjects)) Success = True For i = LBound(regionObjects) To UBound(regionObjects) Set regionObject = regionObjects(i) Success = Success And GetRegionProperties(regionObject, RegProperties(i)) regionObject.Delete ' Effacer la région temporaire Next i GetProperties = Success Exit Function Hell: Debug.Print "Erreur[" & Err.Number & "] : "; Err.Description Err.Clear GetProperties = False End Function Private Function GetRegionProperties(regionObject As AcadRegion, ByRef RegProperties As RegionProperties) As Boolean ' Obtenir les propriétés (aire, périmètre, centroid, etc.) d'une région (n'efface pas les objets) ' regionObject : /* IN */ Region ' RegProperties: tableau des propriétés. Pour ajouter des propriétés, modifier le Type On Error GoTo Hell GetRegionProperties = False RegProperties.Perimeter = regionObject.Perimeter RegProperties.Area = regionObject.Area RegProperties.Centroid(0) = regionObject.Centroid(0) RegProperties.Centroid(1) = regionObject.Centroid(1) RegProperties.MomentOfInertia(0) = regionObject.MomentOfInertia(0) RegProperties.MomentOfInertia(1) = regionObject.MomentOfInertia(1) RegProperties.RadiiOfGyration(0) = regionObject.RadiiOfGyration(0) RegProperties.RadiiOfGyration(1) = regionObject.RadiiOfGyration(1) RegProperties.ProductOfInertia = regionObject.ProductOfInertia RegProperties.PrincipalDirections(0) = regionObject.PrincipalDirections(0) RegProperties.PrincipalDirections(1) = regionObject.PrincipalDirections(1) RegProperties.PrincipalDirections(2) = regionObject.PrincipalDirections(2) RegProperties.PrincipalMoments(0) = regionObject.PrincipalMoments(0) RegProperties.PrincipalMoments(1) = regionObject.PrincipalMoments(1) GetRegionProperties = True Exit Function Hell: Debug.Print "Erreur[" & Err.Number & "] : "; Err.Description Err.Clear GetRegionProperties = False End Function Private Function GetClosedObjects(ByRef ClosedObjects() As AcadEntity, ByVal Mode As Integer) As Boolean ' Sélection d'objets fermés. ' ClosedObjects : /* Out */ collection d'objets trouvés ' Mode : /* In */ acSelectionSetWindow, acSelectionSetCrossing,acSelectionSetAll, ' acSelectionSetPrevious ,acSelectionSetLast ' ou encore 1000 pour SelectOnScreen ' À faire: acSelectionSetFence, acSelectionSetWindowPolygon, acSelectionSetCrossingPolygon ' Valeur de retour: True si la collection contient des objets validés. On Error GoTo Hell GetClosedObjects = False Dim i As Integer Dim sset As AcadSelectionSet Dim FilterType() As Integer Dim FilterData() As Variant Dim Codes As Variant Dim Datas As Variant Codes = Array( _ -4, _ -4, 0, 70, -4, _ -4, 0, 70, -4, _ -4, 0, 41, 42, -4, _ 0, _ 0, _ -4) Datas = Array( _ [surligneur] "< or", _ "< and", "POLYLINE", 1, "and >", _ "< and", "LWPOLYLINE", 1, "and >", _ "< and", "ELLIPSE", 0, 2 * PI, "and >", _ "SPLINE", _ "CIRCLE", _ "or >")[/surligneur] ReDim FilterType(UBound(Codes)) ReDim FilterData(UBound(Codes)) For i = LBound(Codes) To UBound(Codes) FilterType(i) = Codes(i) FilterData(i) = Datas(i) Next i Dim Pt1(0 To 2) As Double Dim Pt2(0 To 2) As Double Dim returnPnt As Variant Set sset = ThisDrawing.SelectionSets.Add("ClosedObjects") Dim Message As String: Message = vbCrLf & "Sélection d'objets fermés" & vbCrLf Select Case Mode Case acSelectionSetWindow, acSelectionSetCrossing ThisDrawing.Utility.Prompt Message returnPnt = ThisDrawing.Utility.GetPoint(, "Premier coin: ") Pt1(0) = returnPnt(0): Pt1(1) = returnPnt(1): Pt1(2) = returnPnt(2) returnPnt = ThisDrawing.Utility.GetCorner(Pt1, "Coin opposé: ") Pt2(0) = returnPnt(0): Pt2(1) = returnPnt(1): Pt2(2) = returnPnt(2) sset.Select acSelectionSetWindow, Pt1, Pt2, FilterType, FilterData Case acSelectionSetAll, acSelectionSetPrevious, acSelectionSetLast sset.Select acSelectionSetWindow, FilterType, FilterData Case 1000 ' SelectOnScreen ThisDrawing.Utility.Prompt Message sset.SelectOnScreen FilterType, FilterData Case Else MsgBox "Mauvais mode passé en paramètre", vbCritical + vbDefaultButton1 + vbOKOnly, "GetClosedObjects" GetClosedObjects = False Exit Function End Select Dim Found As Boolean Dim SelectedObject As AcadEntity Dim SplineObject As AcadSpline Dim Count As Integer Dim IsClosed As Boolean Found = False Count = 0 If sset.Count > 0 Then For i = 0 To sset.Count - 1 Set SelectedObject = sset(i) ' Le cas du Spline est trop complexe pour le gérer via des filtres. Select Case SelectedObject.ObjectName Case "AcDbSpline" Set SplineObject = SelectedObject If SplineObject.Closed = True Then IsClosed = True Case Else IsClosed = True End Select If IsClosed Then ReDim Preserve ClosedObjects(Count) Count = Count + 1 Set ClosedObjects(i) = sset(i) Found = True End If Next i End If ThisDrawing.SelectionSets("ClosedObjects").Delete ' Détruit la collection Set sset = Nothing GetClosedObjects = True Exit Function Hell: Dim SS As AcadSelectionSet If Err.Number = -2145320851 Then ThisDrawing.SelectionSets("ClosedObjects").Delete ' Détruit la collection Set sset = Nothing Resume Next End If Debug.Print "Erreur[" & Err.Number & "] : "; Err.Description If ThisDrawing.SelectionSets.Count > 0 Then For Each SS In ThisDrawing.SelectionSets If SS.Name = "ClosedObjects" Then ThisDrawing.SelectionSets("ClosedObjects").Delete ' Détruit la collection Set sset = Nothing End If Next SS End If GetClosedObjects = False Err.Clear Exit Function End Function Public Sub toto() main End Sub Serge[Edité le 15/8/2008 par Serge][Edité le 15/8/2008 par Serge][Edité le 15/8/2008 par Serge][Edité le 15/8/2008 par Serge][Edité le 15/8/2008 par Serge] [Edité le 15/8/2008 par Serge]

Bonjour à tous, Alors que je cherchais des nouvelles de Patrick, je suis tombé sur cette discussion (après une longue absence, j'ai appris qu'il avait relayé le flambeau). J'aimerais alimenter cette discussion avec ces quelques réflexions: l’état du français chez nous (au Québec), dans le reste du Canada, dans le monde, selon les différences de génération et selon l’utilité qu’on en fait Je suis Québécois donc issu d'une région qui s'est constamment défendu contre l'assimilation. C'est une question de survie. Après la défaire des plaines d'Abraham en 1959 et l'Acte de Québec en 1763, nous sommes devenu des sujets Britanniques. Grâce aux luttes en 1775 et en 1814 au coté des Britanniques dans la guerre entamée par les Américains contre le Canada, nous avons su négocier la protection de notre langue et de notre religion. Grâce à l'entêtement de nos mères, le français a survécu en Amérique du Nord (j'exclus St-Pierre-et-Miquelon) et malgré le fait que nos pères devaient gagner leur croûte dans un marché où le patron (et l'argent) était anglais. Bien sur, nous avons gardé cet accent Breton et Normand d'il y a 200 ans, ce qui nous rend parfois difficile à comprendre. La technologie réduisant les distances, cet accent se fondra probablement au vôtre avec le temps. Lors de ma première visite en France en 1993, je fus profondément peiné d’entendre les cousins utiliser autant d’expressions anglaises (dans la rue comme dans les publicités). Aujourd’hui, avec un peu de recul, je comprends mieux. Pour vous le français n’est pas menacé comme chez nous. D’autre part, ma conjointe travaille pour un organisme qui s’occupe de la promotion de la langue française dans le reste du Canada. Dans les provinces de l’ouest comme dans le nord de l’Ontario, le français est encore plus en péril et les gens sont encore un peu plus respectueux de la langue que nous. C’est surprenant de voir comment ils connaissent les chansonniers français et aux autres éléments culturels. Je n’ai rien contre l’anglais, bien au contraire. Je suis content qu’il y ait enfin une langue universelle. Cela nous permet non seulement de voyager mais de communiquer entre nations. Le plus drôle, c’est que beaucoup d’Indiens (d’Inde) se parlent entre eux en anglais vu leur trop grand nombre de langues. Mais saviez-vous que le français et l’anglais sont les 2 seules langues présentes sur les 5 continents. Il n’y a pas de gêne à bien parler (et écrire en français). J’ajoute que la maîtrise de 2 langues (et plus si on en a la chance) est l’idéal. En passant, j’ai entamé des cours d’espagnol. Je comprends mieux pourquoi les étrangers trouvent le français si difficile. En espagnol, on écrit au son. En français, « eault », « ault », « aud », « eau » « au », « o » ont le même son (on pourrait aussi parler des verbes, des genres, des liaisons, des exceptions). Pour ceux qui me lisent encore ;) , je crois il faut être indulgent, sans être complaisant envers ceux qui s’expriment incorrectement. Il peut s’agir de personnes dont ce n’est pas la langue maternelle. Il peut s’agir de personnes qui ont eu moins d’année de scolarité pour différentes raisons. Une même personne améliorera son français avec les années car elle réalisera non seulement l’image que cela projette mais surtout pour être certain de bien se faire comprendre. Par contre, j’en ai contre ceux qui ne cherchent pas à s’améliorer. Enfin, si je pouvais trouver 2 raisons pour inciter les gens à mieux s’exprimer, je citerais celles-ci : 1) les gens accorderont autant de crédibilité à votre français qu’à ce que vous essayer d’exprimer (ce n’est pas sans raisons que les vendeurs portent une cravate) 2) Si vous écrivez tout croche, comment ferez vous pour faire des recherches ou permettre à d’autres de vous trouver ? Pour Patrick : j’aimerais avoir de tes nouvelles. Je vois que tu aimes l'hémisphère sud. Je ne suis pas surpris de voir des traces d’explorateurs français au Brésil, même après le traité de Tordesilla car cela fait parti nos gènes de trouver de nouvelles voies. Chez nous, Jacques Cartier et Roberval ont tenté une colonisation en 1534 mais il se sont fait expulsé autant par le froid que par les Amérindiens (c'était le temps des conquistadors, Hernán Cortés avait eu de meilleures conditions au Mexique) Serge

bseb67 Avec les réacteurs, il est impossible d'utiliser certaines fonctions, entre autres et sans se limiter à: entget, entmod, entupd, entmake. Il faut obligatoirement passer par les implémentations d'ActiveX (les fonctions vla). Tiré du fichier d'aide: A callback function is a regular AutoLISP function, which you define using defun. However, there are some restrictions on what you can do in a callback function. You cannot call AutoCAD commands using the command function. Also, to access drawing objects, you must use ActiveX® functions; entget and entmod are not allowed inside callback functions. See Reactor Use Guidelines for more information. Serge

ludo07 Je ne veux pas reprendre la solution de gile qui fonctionne probablement (je n'ai pas vérifié et ce sera à lui de poursuivre au besoin). Je voulais juste ajouter un commentaire. Pour avoir développé des objets personnalisés en ObjectARX, il m'a fallut implémenter ma propre version des points d'accrochage (_endpoint, _midpoint, _center, etc.). Ce qu'il faut faire est de définir une fonction (genre réacteur) qui va recevoir l'objet sur lequel on demande le mode d'accrochage, on le décompose en ses plus petits élément de base (les primitives), on évalue le mode d'accrochage sur les primitives, on efface toutes les primitives puis on retourne le point recherché. AutoCAD fait exactement le même travail pour ses propres objets. Tout ça pour dire que la création d'objets temporaires est chose très communes et ne consomme pas de ressources apparentes. Il s'agit de le faire proprement. Ainsi, pour tes centroïdes, tu peux créer une région temporaire, lui faire les requêtes puis l'effacer après usage. Ce n'est pas honteux ni de la mauvaise programmation. Serge

Salut Patrick, a) Pour trouver acLnWt040, il suffit de regarder dans le fichier d'aide sous "Lineweight Property". Autres valeurs: acLnWtByLayer, acLnWtByBlock, acLnWtByLwDefault, acLnWt000, acLnWt005, acLnWt009, acLnWt013, acLnWt015, acLnWt018, acLnWt020, acLnWt025, acLnWt030, acLnWt035, acLnWt040, acLnWt050, acLnWt053, acLnWt060, acLnWt070, acLnWt080, acLnWt090, acLnWt100, acLnWt106, acLnWt120, acLnWt140, acLnWt158, acLnWt200, acLnWt211, b) Je vais dorénavant utiliser vlax-3d-point . Puisque j'avais déjà fait jadis une fonction qui faisait le même travail avec le même effort, je ne m'étais jamais posé de question. Merci. Voici la partie corrigée (en tenant compte aussi d'une transformation conditionnelle) Ligne 289 (setq Point3D (getpoint "\nPoint d'insertion: ")) (if (/= 1 (getvar "worlducs")) (setq Point3D (trans Point3D 1 0))) ; Si pas en WCS (setq vlaPoint3D (vlax-3d-point Point3D)) c) Les tableaux sont relativement très gourmants mais c'est ce qui avait été demandé au départ. Une fois que le tableau est dessiné, il ne prend plus de mémoire et est beaucoup plus facile à éditer (surtout si on veut changer les largeurs de colonnes, la justification, etc. En revanche, un tableau fait à l'ancienne demande beaucoup plus de codes et comporte plus de risque d'erreur. Concernant la vitesse, j'ai du inclure 2 variables pour 'épurer' les lignes et les cellules vides, ainsi que des filtres d'inclusion et d'exclusion. Il n'est pas rare d'avoir des dessins avec 1000 calques et 100 blocs, ce qui aurait donné 100 000 cellules et AutoCAD aurait planté joyeusement (et même pour de plus petits tableaux). Avec les filtres, on obtient un tableau beaucoup plus compact. d) Il y a quelque chose que j'aurais peut-être du faire: si le tableau est vide, je n'affiche pas de message pour l'indiquer. Voici un corectif (pour ne pas tout réécrire). Ligne 334, avant (if CurrentlayerWasLocked (vla-put-lock (vla-get-ActiveLayer ThisDrawing) :vlax-true)) )) Ligne 334, après (if CurrentlayerWasLocked (vla-put-lock (vla-get-ActiveLayer ThisDrawing) :vlax-true)) ) (progn (princ "\nLe tableau est vide.") )) e) Idéalement, les améliorations apportées à la routine c:tableau_Blocs devraient s'appliquer à c:tableau_Perimetres (fonction vlax-3d-point, vérification de l'état du calque, le wcs, les filtres d'exclusion, l'épuration des lignes vides, etc) Serge

adat-btp, Je ne suis pas spécialiste dans la caligraphie chinoise mais le texte ne va pas normalement dans la même direction que nous. Je ne suis pas certain du résultat si on lui substitue une fonte romaine. Il existe 2 variables pour t'aider: 1) FONTALT pour spécifier une fonte d'urgence 2) FONTMAP pour spécifier un fichier dans lequel on fait un mappage d'une série de fontes vers une autre série de fontes. Serge

masterdisco, Fait juste attention au fait que j'ai corrigé la version alors que tu étais en ligne. Il se peut que tu ait copié la première version (ce qui n'est pas mauvais), mais la version éditée tien compte que le calque courant peut être verrouillé (j'ai découvert cela en faisant d'autres tests). Serge

masterdisco (version corrigée pour tenir compte que le calque courant peut être verrouillé) Voilà ! Ce n'est pas dit que j'aurai toujours le temps mais présentement, je suis en vacances et j'avais besoin de me ressourcer en Lisp. Alors ça me fait plaisir. Très important: jeter un coup d'oeil à certaines [surligneur] variables à paramétrer [/surligneur]dans la fonction c:tableau_Blocs sinon le tableau sera très lourd (il y aura une quantité de cellules égale au nombre de blocs x nombre de calques (sans compter les entêtes). Ces variables sont: ;; Noms d'objets acceptés ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z (setq [surligneur] filteredLayers [/surligneur]"*") ; Tout (setq [surligneur] filteredBlockNames [/surligneur]"*") ; Tout ;; Noms d'objets à exclure ;; Exemple pour calques: "" pour aucun, "*$*,*|*" pour tous ceux contenant un $ ou | (i.e. issu de xref) (setq [surligneur] excludedLayers [/surligneur]"defpoint,*$*,*|*") ; Exclure defpoint et ceux issus de Xrefs (setq [surligneur] excludedBlockNames [/surligneur]"`**,*$*,*|*") ; Exclure blocs anonymes et ceux issus de Xrefs ;; Exclusion de lignes ou rangées vides (setq [surligneur] excludeEmptyColumns [/surligneur]t) ; Exclure du tableau si tous les items de la colonne sont 0 (setq [surligneur] excludeEmptyRows [/surligneur]t) ; Exclure du tableau si tous les items de la rangée sont 0 Code à copier ;;; c:tableau_Perimetres ;;; Dessine un tableau illustrant la liste des calques et les périmètres d'objets filtrés (en ModelSpace) ;;; ;;; Compatibilité: AutoCAD 2005 et plus ;;; ;;; Instructions: ;;; 1) Charger ce fichier ;;; 2) Tapez TABLEAU_PERIMETRES sur la ligne de commande ;;; 3) Indiquez le point d'insertion ;;; 4) La partie Personnalisation peut être modifiés. ;;; ;;; Par Serge Camiré, CadNovation, 2008/08/12 ;;; http://www.cadnovation.com/fr ;;; (vl-load-com) (defun c:tableau_Perimetres ( / acadObject column ColWidth endPt filteredLayers filteredObjets i LayerCount LayerName layerNames lcLayerName LineWeightMedium LineWeightNone LineWeightThick ModelSpace n NumColumns NumRows objectName perimeter Point3D_UCS Point3D_WCS Resultat Resultats row RowHeight tableau textsize ThisDrawing Total vlaLayers vlaPoint3D vlaTableau ) ;; ====================================================================================================================== ;; Personnalisation ;; ====================================================================================================================== ;; Liste des calques et objets désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z ;; Exemple pour objets "*" pour tous les objets "*line,circle" pour tous les objets dont le nom se termine par "line", ainsi que les cercles (setq filteredLayers "*") (setq filteredObjets "*line") ;; Taille du tableau (setq textsize (getvar "textsize")) ; Voir cette variable qui contrôle la hauteur du texte (setq RowHeight (* 2.0 textsize)) (setq ColWidth (* 10.0 RowHeight)) ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes (setq LineWeightThick acLnWt090) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) (setq LineWeightMedium acLnWt040) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) (setq LineWeightNone acLnWt000) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) ;; ====================================================================================================================== ;; Ne pas modifier la suite du programme ;; ====================================================================================================================== (setq filteredLayers (strcase filteredLayers t)) ; Minuscules (setq filteredObjets (strcase filteredObjets t)) ; Minuscules (setq acadObject (vlax-get-acad-object)) (setq ThisDrawing (vla-get-ActiveDocument acadObject)) (setq ModelSpace (vla-get-ModelSpace ThisDrawing)) (setq vlaLayers (vla-get-Layers ThisDrawing)) (setq LayerCount (vla-get-count vlaLayers)) (setq Point3D_UCS (getpoint "\nPoint d'insertion: ")) (setq Point3D_WCS (trans Point3D_UCS 1 0)) ; Si pas en WCS (setq vlaPoint3D (PointToVariant Point3D_WCS)) ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table) ;; dont les paires sont (LayerName Count) (setq Resultats nil) (setq layerNames nil) (vlax-for vlaLayer vlaLayers (setq layerName (vla-get-name vlaLayer)) (setq lcLayerName (strcase layerName t)) ; Minuscules (if (wcmatch lcLayerName filteredLayers) (setq layerNames (cons lcLayerName layerNames))) ) (setq layerNames (vl-sort layerNames '<)) ; Trier en ordre croissant (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) layerNames)) (vlax-for vlaObject ModelSpace (if (and (wcmatch (setq objectName (strcase (vla-get-ObjectName vlaObject) t)) filteredObjets) (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers) ) (progn (setq endPt (vlax-curve-getEndParam vlaObject)) (setq perimeter (vlax-curve-getDistAtParam vlaObject endPt)) (setq Total (+ perimeter (cdr (assoc layerName Resultats)))) (setq Resultats (subst (cons layerName Total) (assoc layerName Resultats) Resultats)) )) ) (setq NumRows (+ 3 LayerCount)) ; 2 lignes de titre + total (setq NumColumns 2) (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth)) ;; Ligne 0 (setq row 0) (setq column 0) (SetCellProperties vlaTableau row column "Résultats" textsize acMiddleCenter nil) ;; Ligne 1, colonne 0 (setq row 1) (setq column 0) (SetCellProperties vlaTableau row column "Calques" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium)) ;; Ligne 1, colonne 1 (setq row 1) (setq column 1) (SetCellProperties vlaTableau row column "Périmètres" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium)) ;; Lignes de résultat (setq i 0) (setq n LayerCount) (setq Total 0.0) (while (< i n) (setq Resultat (nth i Resultats)) (setq row (+ i 2)) ;; Calque (setq column 0) (setq layerName (strcase (car Resultat))) (SetCellProperties vlaTableau row column layerName textsize acMiddleLeft nil) ;; Périmètre (setq column 1) (setq perimeter (cdr Resultat)) (setq Total (+ Total perimeter)) (SetCellProperties vlaTableau row column (rtos perimeter) textsize acMiddleRight nil) (setq i (1+ i)) ) ;; Total (setq row (+ LayerCount 2)) (setq column 0) (setq layerName "Total") (SetCellProperties vlaTableau row column layerName textsize acMiddleLeft (cons acHorzTop LineWeightMedium)) ;; Périmètre total (setq column 1) (setq perimeter Total) (setq Total (+ Total perimeter)) (SetCellProperties vlaTableau row column (rtos perimeter) textsize acMiddleRight nil) ) ;;; c:tableau_Blocs ;;; Dessine un tableau illustrant la liste des calques et les blocs filtrés (en ModelSpace) ;;; ;;; Compatibilité: AutoCAD 2005 et plus ;;; ;;; Instructions: ;;; 1) Charger ce fichier ;;; 2) Tapez TABLEAU_BLOCS sur la ligne de commande ;;; 3) Indiquez le point d'insertion ;;; 4) La partie Personnalisation peut être modifiés. ;;; ;;; IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT ;;; Parmi les items à personnaliser, il faut prêter attention à ces variables ;;; ;; Noms d'objets acceptés ;;; (setq filteredLayers "*") ;;; (setq filteredBlockNames "*") ;;; ;;; ;; Noms d'objets à exclure ;;; ;; Exemple pour calques: "" pour aucun, "*$*,*|*" pour tous ceux contenant un $ ou | (i.e. issu de xref) ;;; (setq excludedLayers "defpoint,*$*,*|*") ; Exclure defpoint et ceux issus de Xrefs ;;; (setq excludedBlockNames "`**,*$*,*|*") ; Exclure blocs anonymes et ceux issus de Xrefs ;;; ;;; ;; Exclusion de lignes ou rangées vides ;;; (setq excludeEmptyColumns t) ; Exclure du tableau si tous les items de la colonne sont 0 ;;; (setq excludeEmptyRows t) ; Exclure du tableau si tous les items de la rangée sont 0 ;;; ;;; ;;; Par Serge Camiré, CadNovation, 2008/08/14 ;;; http://www.cadnovation.com/fr ;;; (defun c:tableau_Blocs ( / acadObject blockName blockNames column ColWidth Count CurrentlayerWasLocked excludedBlockNames excludedLayers excludeEmptyColumns excludeEmptyRows filteredBlockNames filteredLayers i j layerName layerNames lcBlockName lcLayerName LineWeightMedium LineWeightNone LineWeightThick m ModelSpace n NumColumns NumRows Point3D_UCS Point3D_WCS Resultats ResultatsBlock ResultatsBlocks ResultatsLayersBlocks row RowHeight textsize ThisDrawing total vlaBlocks vlaLayers vlaPoint3D vlaTableau ) ;; Liste des calques et noms de bloc désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules ;; Le résultats est un tableau dont les titre de colonne sont les noms de bloc et les titres de rangée sont les calques. ;; Noms d'objets acceptés ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z (setq filteredLayers "*") ; Tout (setq filteredBlockNames "*") ; Tout ;; Noms d'objets à exclure ;; Exemple pour calques: "" pour aucun, "*$*,*|*" pour tous ceux contenant un $ ou | (i.e. issu de xref) (setq excludedLayers "defpoint,*$*,*|*") ; Exclure defpoint et ceux issus de Xrefs (setq excludedBlockNames "`**,*$*,*|*") ; Exclure blocs anonymes et ceux issus de Xrefs ;; Exclusion de lignes ou rangées vides (setq excludeEmptyColumns t) ; Exclure du tableau si tous les items de la colonne sont 0 (setq excludeEmptyRows t) ; Exclure du tableau si tous les items de la rangée sont 0 ;; Taille du tableau (setq textsize (getvar "textsize")) ; Voir cette variable qui contrôle la hauteur du texte (setq RowHeight (* 2.0 textsize)) (setq ColWidth (* 10.0 RowHeight)) ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes (setq LineWeightThick acLnWt090) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) (setq LineWeightMedium acLnWt040) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) (setq LineWeightNone acLnWt000) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) ;; ====================================================================================================================== ;; Ne pas modifier la suite du programme ;; ====================================================================================================================== (setq filteredLayers (strcase filteredLayers t)) ; Minuscules (setq filteredBlockNames (strcase filteredBlockNames t)) ; Minuscules (setq acadObject (vlax-get-acad-object)) (setq ThisDrawing (vla-get-ActiveDocument acadObject)) (setq ModelSpace (vla-get-ModelSpace ThisDrawing)) (setq vlaBlocks (vla-get-blocks ThisDrawing)) (setq vlaLayers (vla-get-Layers ThisDrawing)) ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table) ;; dont les paires sont (LayerName Count) (setq ResultatsBlocks nil) (setq BlockNames nil) (vlax-for vlaBlock vlaBlocks (setq blockName (GetBlockName vlaBlock)) ; Nom du bloc (accepte les blocs dynamiques. (setq lcBlockName (strcase blockName t)) ; Minuscules, blocs nommés (if (and (wcmatch lcBlockName filteredBlockNames) (not (wcmatch lcBlockName excludedBlockNames)) ) (setq BlockNames (cons lcBlockName BlockNames)) ) ) (setq BlockNames (vl-sort BlockNames '<)) ; Trier en ordre croissant (setq ResultatsBlocks (mapcar '(lambda (x) (cons x 0)) BlockNames)) (setq ResultatsLayersBlocks nil) (setq layerNames nil) (vlax-for vlaLayer vlaLayers (setq layerName (vla-get-name vlaLayer)) (setq lcLayerName (strcase layerName t)) ; Minuscules (if (and (wcmatch lcLayerName filteredLayers) (not (wcmatch lcLayerName excludedLayers)) ) (setq layerNames (cons lcLayerName layerNames)) ) ) (setq layerNames (vl-sort layerNames '<)) ; Trier en ordre croissant (setq ResultatsLayersBlocks (mapcar '(lambda (x) (cons x ResultatsBlocks)) layerNames)) (vlax-for vlaObject ModelSpace (if (and (= "AcDbBlockReference" (vla-get-ObjectName vlaObject)) (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers) (wcmatch (setq blockName (strcase (GetBlockName vlaObject) t)) filteredBlockNames) (setq ResultatsBlocks (cdr (assoc layerName ResultatsLayersBlocks))) (setq ResultatsBlock (assoc blockName ResultatsBlocks)) ) (progn (setq Total (1+ (cdr ResultatsBlock))) (setq ResultatsBlocks (subst (cons blockName Total) (assoc blockName ResultatsBlocks) ResultatsBlocks)) (setq ResultatsLayersBlocks (subst (cons layerName ResultatsBlocks) (assoc layerName ResultatsLayersBlocks) ResultatsLayersBlocks)) )) ) (if (and ResultatsLayersBlocks excludeEmptyRows) (progn ;; Nettoyage des lignes vides (setq ResultatsLayersBlocks (vl-remove-if '(lambda (x) (= 0 (apply '+ (mapcar 'cdr (cdr x))))) ResultatsLayersBlocks)) )) (if (and ResultatsLayersBlocks excludeEmptyColumns) (progn ;; Nettoyage des colonnes vides (setq j (length BlockNames)) (while (> j 0) (setq j (1- j)) (setq BlockName (nth j BlockNames)) (if (= 0 (apply '+ (mapcar '(lambda (x) (cdr (nth j (cdr x)))) ResultatsLayersBlocks))) (progn (setq ResultatsLayersBlocks (mapcar '(lambda (x) (cons (car x) (vl-remove-if '(lambda (y) (= BlockName (car y))) (cdr x)))) ResultatsLayersBlocks)) (setq BlockNames (vl-remove-if '(lambda (x) (= x BlockName)) BlockNames)) )) ) )) ;; Dessiner le tableau, s'il reste des calques et des blocs après épuration (if (> (* (length BlockNames) (length ResultatsLayersBlocks)) 0) (progn (setq NumRows (+ 2 (length ResultatsLayersBlocks))) ; 2 lignes de titre (setq NumColumns (+ 1 (length BlockNames))) ; 1 colonne de plus pour les noms de calque (setq Point3D_UCS (getpoint "\nPoint d'insertion: ")) (setq Point3D_WCS (trans Point3D_UCS 1 0)) ; Si pas en WCS (setq vlaPoint3D (PointToVariant Point3D_WCS)) (setq CurrentlayerWasLocked (= :vlax-true (vla-get-lock (vla-get-ActiveLayer ThisDrawing)))) (if CurrentlayerWasLocked (vla-put-lock (vla-get-ActiveLayer ThisDrawing) :vlax-false)) (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth)) ;; Ligne 0 (setq row 0) (setq column 0) (SetCellProperties vlaTableau row column "Résultats" textsize acMiddleCenter nil) ;; Ligne 1 (setq row 1) (setq column 0) (while (< column (length BlockNames)) (SetCellProperties vlaTableau row (1+ column) (nth column BlockNames) textsize acMiddleCenter (cons acHorzBottom LineWeightMedium)) (setq column (1+ column)) ) ;; Lignes de résultat (setq i 0) (setq n (length ResultatsLayersBlocks)) (while (< i n) (setq ResultatsBlocks (nth i ResultatsLayersBlocks)) (setq row (+ i 2)) ; On saute les 2 lignes de titre ;; LayerName (setq column 0) (setq LayerName (car ResultatsBlocks)) (SetCellProperties vlaTableau row column LayerName textsize acMiddleLeft nil) ;; Quantité (setq j 0) (setq m (length BlockNames)) (setq ResultatsBlocks (cdr ResultatsBlocks)) (while (< j m) (setq column (1+ j)) ; On saute la colonne des noms de calque (setq Count (cdr (nth j ResultatsBlocks))) (SetCellProperties vlaTableau row column (itoa Count) textsize acMiddleCenter nil) (setq j (1+ j)) ) (setq i (1+ i)) ) (if CurrentlayerWasLocked (vla-put-lock (vla-get-ActiveLayer ThisDrawing) :vlax-true)) )) (princ) ) (defun SetCellProperties ( vlaTableau Row Column Texte TextHeight Alignment LineWeightPair ) ;; Gère les propriétés populaires des cellules d'un tableau ;; vlaTableau Row Column : Obligatoire, les autres sont facultatifs ;; Row, Column : INT, base 0 ;; Alignment: INT, ;; LineWeightPair: nil, sinon (cons "AcGridLineType enum" "acad_lweight enum"), soit (cons Position Épaisseur) ;; Support pour Acad2006 et Acad2009 (if LineWeightPair (vla-SetCellGridLineWeight vlaTableau Row Column (car LineWeightPair) (cdr LineWeightPair))) (if Alignment (vla-SetCellAlignment vlaTableau Row Column Alignment)) (if TextHeight (vla-SetCellTextHeight vlaTableau Row Column TextHeight)) (if Texte (if vla-SetCellValue (vla-SetCellValue vlaTableau Row Column Texte) ; AutoCAD 2009 (vla-SetText vlaTableau Row Column Texte) ; AutoCAD 2006 ) ) ) ;;; PointToVariant ;;; Conversion de Point2D ou Point3D en variant (defun PointToVariant ( point / arraySpace sArray ) (setq arraySpace (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length point))))) (setq sArray (vlax-safearray-fill arraySpace point)) (vlax-make-variant sArray) ) ;;; Obtenir le nom du bloc (accepte les blocs dynamiques) (defun GetBlockName (vlaBlock) (if (vlax-property-available-p vlaBlock 'EffectiveName) (vla-get-EffectiveName vlaBlock) (vla-get-Name vlaBlock)) ) Serge [Edité le 14/8/2008 par Serge]

masterdisco, Voici le code corrigé. Je me suis rendu compte de bien des petites choses: 1) les méthodes ne sont pas toutes identiques selon la version d'AutoCAD. J'ai corrigé et testé avec succès en 2006 et 2009 2) le support du SCU 3) le support des blocs dynamiques (merci à Gile) ;;; c:tableau_Perimetres ;;; Dessine un tableau illustrant la liste des calques et les périmètres d'objets filtrés (en ModelSpace) ;;; ;;; Compatibilité: AutoCAD 2005 et plus ;;; ;;; Instructions: ;;; 1) Charger ce fichier ;;; 2) Tapez TABLEAU_PERIMETRES sur la ligne de commande ;;; 3) Indiquez le point d'insertion ;;; 4) La partie Personnalisation peut être modifiés. ;;; ;;; Par Serge Camiré, CadNovation, 2008/08/12 ;;; http://www.cadnovation.com/fr ;;; (vl-load-com) (defun c:tableau_Perimetres ( / acadObject column ColWidth endPt filteredLayers filteredObjets i LayerCount LayerName layerNames lcLayerName LineWeightMedium LineWeightNone LineWeightThick ModelSpace n NumColumns NumRows objectName perimeter Point3D_UCS Point3D_WCS Resultat Resultats row RowHeight tableau textsize ThisDrawing Total vlaLayers vlaPoint3D vlaTableau ) ;; ====================================================================================================================== ;; Personnalisation ;; ====================================================================================================================== ;; Liste des calques et objets désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z ;; Exemple pour objets "*" pour tous les objets "*line,circle" pour tous les objets dont le nom se termine par "line", ainsi que les cercles (setq filteredLayers "*") (setq filteredObjets "*line") ;; Taille du tableau (setq textsize (getvar "textsize")) ; Voir cette variable qui contrôle la hauteur du texte (setq RowHeight (* 2.0 textsize)) (setq ColWidth (* 10.0 RowHeight)) ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes (setq LineWeightThick acLnWt090) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) (setq LineWeightMedium acLnWt040) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) (setq LineWeightNone acLnWt000) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) ;; ====================================================================================================================== ;; Ne pas modifier la suite du programme ;; ====================================================================================================================== (setq filteredLayers (strcase filteredLayers t)) ; Minuscules (setq filteredObjets (strcase filteredObjets t)) ; Minuscules (setq acadObject (vlax-get-acad-object)) (setq ThisDrawing (vla-get-ActiveDocument acadObject)) (setq ModelSpace (vla-get-ModelSpace ThisDrawing)) (setq vlaLayers (vla-get-Layers ThisDrawing)) (setq LayerCount (vla-get-count vlaLayers)) (setq Point3D_UCS (getpoint "\nPoint d'insertion: ")) (setq Point3D_WCS (trans Point3D_UCS 1 0)) ; Si pas en WCS (setq vlaPoint3D (PointToVariant Point3D_WCS)) (setq NumRows (+ 3 LayerCount)) ; 2 lignes de titre + total (setq NumColumns 2) ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table) ;; dont les paires sont (LayerName Count) (setq Resultats nil) (setq layerNames nil) (vlax-for vlaLayer vlaLayers (setq layerName (vla-get-name vlaLayer)) (setq lcLayerName (strcase layerName t)) ; Minuscules (if (wcmatch lcLayerName filteredLayers) (setq layerNames (cons lcLayerName layerNames))) ) (setq layerNames (vl-sort layerNames '<)) ; Trier en ordre croissant (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) layerNames)) (vlax-for vlaObject ModelSpace (if (and (wcmatch (setq objectName (strcase (vla-get-ObjectName vlaObject) t)) filteredObjets) (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers) ) (progn (setq endPt (vlax-curve-getEndParam vlaObject)) (setq perimeter (vlax-curve-getDistAtParam vlaObject endPt)) (setq Total (+ perimeter (cdr (assoc layerName Resultats)))) (setq Resultats (subst (cons layerName Total) (assoc layerName Resultats) Resultats)) )) ) ;; Ligne 0 (setq row 0) (setq column 0) (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth)) (SetCellProperties vlaTableau row column "Résultats" textsize acMiddleCenter nil) ;; Ligne 1, colonne 0 (setq row 1) (setq column 0) (SetCellProperties vlaTableau row column "Calques" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium)) ;; Ligne 1, colonne 1 (setq row 1) (setq column 1) (SetCellProperties vlaTableau row column "Périmètres" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium)) ;; Lignes de résultat (setq i 0) (setq n LayerCount) (setq Total 0.0) (while (< i n) (setq Resultat (nth i Resultats)) (setq row (+ i 2)) ;; Calque (setq column 0) (setq layerName (strcase (car Resultat))) (SetCellProperties vlaTableau row column layerName textsize acMiddleLeft nil) ;; Périmètre (setq column 1) (setq perimeter (cdr Resultat)) (setq Total (+ Total perimeter)) (SetCellProperties vlaTableau row column (rtos perimeter) textsize acMiddleRight nil) (setq i (1+ i)) ) ;; Total (setq row (+ LayerCount 2)) (setq column 0) (setq layerName "Total") (SetCellProperties vlaTableau row column layerName textsize acMiddleLeft (cons acHorzTop LineWeightMedium)) ;; Périmètre total (setq column 1) (setq perimeter Total) (setq Total (+ Total perimeter)) (SetCellProperties vlaTableau row column (rtos perimeter) textsize acMiddleRight nil) ) ;;; c:tableau_Blocs ;;; Dessine un tableau illustrant la liste des calques et les blocs filtrés (en ModelSpace) ;;; ;;; Compatibilité: AutoCAD 2005 et plus ;;; ;;; Instructions: ;;; 1) Charger ce fichier ;;; 2) Tapez TABLEAU_BLOCS sur la ligne de commande ;;; 3) Indiquez le point d'insertion ;;; 4) La partie Personnalisation peut être modifiés. ;;; ;;; Par Serge Camiré, CadNovation, 2008/08/12 ;;; http://www.cadnovation.com/fr ;;; (defun c:tableau_Blocs ( / acadObject blockName BlockNameCount blockNames column ColWidth filteredBlockNames filteredLayers i layerName lcBlockName LineWeightMedium LineWeightNone LineWeightThick ModelSpace n NumColumns NumRows perimeter Point3D_UCS Point3D_WCS Resultat Resultats row RowHeight textsize ThisDrawing total vlaBlocks vlaPoint3D vlaTableau ) ;; Liste des calques et noms de bloc désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z ;; Exemple pour blockNames "*" pour tous les objets "*line,circle" pour tous les objets dont le nom se termine par "line", ainsi que les cercles (setq filteredLayers "*") (setq filteredBlockNames "*") ;; Taille du tableau (setq textsize (getvar "textsize")) ; Voir cette variable qui contrôle la hauteur du texte (setq RowHeight (* 2.0 textsize)) (setq ColWidth (* 10.0 RowHeight)) ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes (setq LineWeightThick acLnWt090) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) (setq LineWeightMedium acLnWt040) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) (setq LineWeightNone acLnWt000) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) ;; Ne pas modifier la suite du programme (setq filteredLayers (strcase filteredLayers t)) ; Minuscules (setq filteredBlockNames (strcase filteredBlockNames t)) ; Minuscules (setq acadObject (vlax-get-acad-object)) (setq ThisDrawing (vla-get-ActiveDocument acadObject)) (setq ModelSpace (vla-get-ModelSpace ThisDrawing)) (setq vlaBlocks (vla-get-blocks ThisDrawing)) (setq Point3D_UCS (getpoint "\nPoint d'insertion: ")) (setq Point3D_WCS (trans Point3D_UCS 1 0)) ; Si pas en WCS (setq vlaPoint3D (PointToVariant Point3D_WCS)) (setq NumColumns 2) ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table) ;; dont les paires sont (LayerName Count) (setq Resultats nil) (setq BlockNames nil) (vlax-for vlaBlock vlaBlocks (setq blockName (GetBlockName vlaBlock)) ; Nom du bloc (accepte les blocs dynamiques. (setq lcBlockName (strcase blockName t)) ; Minuscules, blocs nommés (if (and (/= "*" (substr lcBlockName 1 1)) (wcmatch lcBlockName filteredBlockNames)) (setq BlockNames (cons lcBlockName BlockNames))) ) (setq BlockNames (vl-sort BlockNames '<)) ; Trier en ordre croissant (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) BlockNames)) (vlax-for vlaObject ModelSpace (if (and (= "AcDbBlockReference" (vla-get-ObjectName vlaObject)) (wcmatch (setq blockName (strcase (GetBlockName vlaObject) t)) filteredBlockNames) (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers) ) (progn (setq Total (1+ (cdr (assoc blockName Resultats)))) (setq Resultats (subst (cons blockName Total) (assoc blockName Resultats) Resultats)) )) ) (setq NumRows (+ 2 (length Resultats))) ; 2 lignes de titre (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth)) ;; Ligne 0 (setq row 0) (setq column 0) (SetCellProperties vlaTableau row column "Résultats" textsize acMiddleCenter nil) ;; Ligne 1, colonne 0 (setq row 1) (setq column 0) (SetCellProperties vlaTableau row column "Blocs" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium)) ;; Ligne 1, colonne 1 (setq row 1) (setq column 1) (SetCellProperties vlaTableau row column "Quantité" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium)) ;; Lignes de résultat (setq i 0) (setq n (length Resultats)) (setq Total 0.0) (while (< i n) (setq Resultat (nth i Resultats)) (setq row (+ i 2)) ;; BlockName (setq column 0) (setq BlockName (strcase (car Resultat))) (SetCellProperties vlaTableau row column BlockName textsize acMiddleLeft nil) ;; Quantité (setq column 1) (setq Total (cdr Resultat)) (SetCellProperties vlaTableau row column (rtos Total 2 0) textsize acMiddleCenter nil) (setq i (1+ i)) ) ) (defun SetCellProperties ( vlaTableau Row Column Texte TextHeight Alignment LineWeightPair ) ;; Gère les propriétés populaires des cellules d'un tableau ;; vlaTableau Row Column : Obligatoire, les autres sont facultatifs ;; Row, Column : INT, base 0 ;; Alignment: INT, ;; LineWeightPair: nil, sinon (cons "AcGridLineType enum" "acad_lweight enum"), soit (cons Position Épaisseur) ;; Support pour Acad2006 et Acad2009 (if LineWeightPair (vla-SetCellGridLineWeight vlaTableau Row Column (car LineWeightPair) (cdr LineWeightPair))) (if Alignment (vla-SetCellAlignment vlaTableau Row Column Alignment)) (if TextHeight (vla-SetCellTextHeight vlaTableau Row Column TextHeight)) (if Texte (if vla-SetCellValue (vla-SetCellValue vlaTableau Row Column Texte) ; AutoCAD 2009 (vla-SetText vlaTableau Row Column Texte) ; AutoCAD 2006 ) ) ) ;;; PointToVariant ;;; Conversion de Point2D ou Point3D en variant (defun PointToVariant ( point / arraySpace sArray ) (setq arraySpace (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length point))))) (setq sArray (vlax-safearray-fill arraySpace point)) (vlax-make-variant sArray) ) ;;; Obtenir le nom du bloc (accepte les blocs dynamiques) (defun GetBlockName (vlaBlock) (if (vlax-property-available-p vlaBlock 'EffectiveName) (vla-get-EffectiveName vlaBlock) (vla-get-Name vlaBlock)) ) Serge

masterdisco Voici du code qui produit un tableau de périmètres et un autre de blocs. Les 2 commandes sont expliquées dans les commentaires. Donne-moi en des nouvelles. ;;; c:tableau_Perimetres ;;; Dessine un tableau illustrant la liste des calques et les périmètres d'objets filtrés (en ModelSpace) ;;; ;;; Compatibilité: AutoCAD 2005 et plus ;;; ;;; Instructions: ;;; 1) Charger ce fichier ;;; 2) Tapez TABLEAU_PERIMETRES sur la ligne de commande ;;; 3) Indiquez le point d'insertion ;;; 4) La partie Personnalisation peut être modifiés. ;;; ;;; Par Serge Camiré, CadNovation, 2008/08/12 ;;; http://www.cadnovation.com/fr ;;; (defun c:tableau_Perimetres ( / acadObject ColWidth endPt filteredLayers filteredObjets i LayerCount LayerName layerNames lcLayerName LineWeight ModelSpace n NumColumns NumRows objectName perimeter Point2D Resultat Resultats row RowHeight tableau textsize ThisDrawing Total vlaLayers vlaPoint3D vlaTableau ) ;; ====================================================================================================================== ;; Personnalisation ;; ====================================================================================================================== ;; Liste des calques et objets désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z ;; Exemple pour objets "*" pour tous les objets "*line,circle" pour tous les objets dont le nom se termine par "line", ainsi que les cercles (setq filteredLayers "*") (setq filteredObjets "*line") ;; Taille du tableau (setq textsize (getvar "textsize")) ; Voir cette variable qui contrôle la hauteur du texte (setq RowHeight (* 2.0 textsize)) (setq ColWidth (* 10.0 RowHeight)) ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes (setq LineWeight acLnWt040) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) ;; ====================================================================================================================== ;; Ne pas modifier la suite du programme ;; ====================================================================================================================== (setq filteredLayers (strcase filteredLayers t)) ; Minuscules (setq filteredObjets (strcase filteredObjets t)) ; Minuscules (setq acadObject (vlax-get-acad-object)) (setq ThisDrawing (vla-get-ActiveDocument acadObject)) (setq ModelSpace (vla-get-ModelSpace ThisDrawing)) (setq vlaLayers (vla-get-Layers ThisDrawing)) (setq LayerCount (vla-get-count vlaLayers)) (setq Point2D (getpoint "\nPoint d'insertion: ")) (setq vlaPoint3D (PointToVariant Point2D)) (setq NumRows (+ 3 LayerCount)) ; 2 lignes de titre + total (setq NumColumns 2) ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table) ;; dont les paires sont (LayerName Count) (setq Resultats nil) (setq layerNames nil) (vlax-for vlaLayer vlaLayers (setq layerName (vla-get-name vlaLayer)) (setq lcLayerName (strcase layerName t)) ; Minuscules (if (wcmatch lcLayerName filteredLayers) (setq layerNames (cons lcLayerName layerNames))) ) (setq layerNames (vl-sort layerNames '<)) ; Trier en ordre croissant (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) layerNames)) (vlax-for vlaObject ModelSpace (if (and (wcmatch (setq objectName (strcase (vla-get-ObjectName vlaObject) t)) filteredObjets) (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers) ) (progn (setq endPt (vlax-curve-getEndParam vlaObject)) (setq perimeter (vlax-curve-getDistAtParam vlaObject endPt)) (setq Total (+ perimeter (cdr (assoc layerName Resultats)))) (setq Resultats (subst (cons layerName Total) (assoc layerName Resultats) Resultats)) )) ) ;; Ligne 0 (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth)) (vla-SetCellAlignment vlaTableau 0 0 acMiddleCenter) (vla-SetCellTextHeight vlaTableau 0 0 textsize) (vla-SetCellValue vlaTableau 0 0 "Résultats") ;; Ligne 1, colonne 0 (vla-SetCellGridLineWeight vlaTableau 1 0 4 LineWeight) (vla-SetCellAlignment vlaTableau 1 0 acMiddleCenter) (vla-SetCellTextHeight vlaTableau 1 0 textsize) (vla-SetCellValue vlaTableau 1 0 "Calques") ;; Ligne 1, colonne 1 (vla-SetCellGridLineWeight vlaTableau 1 1 4 LineWeight) (vla-SetCellAlignment vlaTableau 1 1 acMiddleCenter) (vla-SetCellTextHeight vlaTableau 1 1 textsize) (vla-SetCellValue vlaTableau 1 1 "Périmètres") ;; Lignes de résultat (setq i 0) (setq n LayerCount) (setq Total 0.0) (while (< i n) (setq Resultat (nth i Resultats)) (setq row (+ i 2)) ;; Calque (setq layerName (strcase (car Resultat))) (vla-SetCellAlignment vlaTableau row 0 acMiddleLeft) (vla-SetCellTextHeight vlaTableau row 0 textsize) (vla-SetCellValue vlaTableau row 0 layerName) ;; Périmètre (setq perimeter (cdr Resultat)) (setq Total (+ Total perimeter)) (vla-SetCellAlignment vlaTableau row 1 acMiddleRight) (vla-SetCellTextHeight vlaTableau row 1 textsize) (vla-SetCellValue vlaTableau row 1 (rtos perimeter)) (setq i (1+ i)) ) ;; Total (setq row (+ LayerCount 2)) (setq layerName "Total") (vla-SetCellGridLineWeight vlaTableau row 0 1 LineWeight) (vla-SetCellAlignment vlaTableau row 0 acMiddleLeft) (vla-SetCellTextHeight vlaTableau row 0 textsize) (vla-SetCellValue vlaTableau row 0 layerName) ;; Périmètre total (setq perimeter Total) (setq Total (+ Total perimeter)) (vla-SetCellGridLineWeight vlaTableau row 1 1 LineWeight) (vla-SetCellAlignment vlaTableau row 1 acMiddleRight) (vla-SetCellTextHeight vlaTableau row 1 textsize) (vla-SetCellValue vlaTableau row 1 (rtos perimeter)) ) ;;; c:tableau_Blocs ;;; Dessine un tableau illustrant la liste des calques et les blocs filtrés (en ModelSpace) ;;; ;;; Compatibilité: AutoCAD 2005 et plus ;;; ;;; Instructions: ;;; 1) Charger ce fichier ;;; 2) Tapez TABLEAU_BLOCS sur la ligne de commande ;;; 3) Indiquez le point d'insertion ;;; 4) La partie Personnalisation peut être modifiés. ;;; ;;; Par Serge Camiré, CadNovation, 2008/08/12 ;;; http://www.cadnovation.com/fr ;;; (defun c:tableau_Blocs ( / acadObject blockName BlockNameCount blockNames ColWidth filteredBlockNames filteredLayers i layerName lcBlockName LineWeight ModelSpace n NumColumns NumRows perimeter Point2D Resultat Resultats row RowHeight textsize ThisDrawing total vlaBlocks vlaPoint3D vlaTableau ) ;; Liste des calques et noms de bloc désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z ;; Exemple pour blockNames "*" pour tous les objets "*line,circle" pour tous les objets dont le nom se termine par "line", ainsi que les cercles (setq filteredLayers "*") (setq filteredBlockNames "*") ;; Taille du tableau (setq textsize (getvar "textsize")) ; Voir cette variable qui contrôle la hauteur du texte (setq RowHeight (* 2.0 textsize)) (setq ColWidth (* 10.0 RowHeight)) ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes (setq LineWeight acLnWt040) ; Épaisseur de la ligne de séparation (voir LWDISPLAY) ;; Ne pas modifier la suite du programme (setq filteredLayers (strcase filteredLayers t)) ; Minuscules (setq filteredBlockNames (strcase filteredBlockNames t)) ; Minuscules (setq acadObject (vlax-get-acad-object)) (setq ThisDrawing (vla-get-ActiveDocument acadObject)) (setq ModelSpace (vla-get-ModelSpace ThisDrawing)) (setq vlaBlocks (vla-get-blocks ThisDrawing)) (setq Point2D (getpoint "\nPoint d'insertion: ")) (setq vlaPoint3D (PointToVariant Point2D)) (setq NumColumns 2) ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table) ;; dont les paires sont (LayerName Count) (setq Resultats nil) (setq BlockNames nil) (vlax-for vlaBlock vlaBlocks (setq blockName (vla-get-name vlablock)) (setq lcBlockName (strcase blockName t)) ; Minuscules, blocs nommés (if (and (/= "*" (substr lcBlockName 1 1)) (wcmatch lcBlockName filteredBlockNames)) (setq BlockNames (cons lcBlockName BlockNames))) ) (setq BlockNames (vl-sort BlockNames '<)) ; Trier en ordre croissant (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) BlockNames)) (vlax-for vlaObject ModelSpace (if (and (= "AcDbBlockReference" (vla-get-ObjectName vlaObject)) (wcmatch (setq blockName (strcase (vla-get-Name vlaObject) t)) filteredBlockNames) (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers) ) (progn (setq Total (1+ (cdr (assoc blockName Resultats)))) (setq Resultats (subst (cons blockName Total) (assoc blockName Resultats) Resultats)) )) ) ;; Ligne 0 (setq NumRows (+ 2 (length Resultats))) ; 2 lignes de titre (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth)) (vla-SetCellAlignment vlaTableau 0 0 acMiddleCenter) (vla-SetCellTextHeight vlaTableau 0 0 textsize) (vla-SetCellValue vlaTableau 0 0 "Résultats") ;; Ligne 1, colonne 0 (vla-SetCellGridLineWeight vlaTableau 1 0 4 LineWeight) (vla-SetCellAlignment vlaTableau 1 0 acMiddleCenter) (vla-SetCellTextHeight vlaTableau 1 0 textsize) (vla-SetCellValue vlaTableau 1 0 "Blocs") ;; Ligne 1, colonne 1 (vla-SetCellGridLineWeight vlaTableau 1 1 4 LineWeight) (vla-SetCellAlignment vlaTableau 1 1 acMiddleCenter) (vla-SetCellTextHeight vlaTableau 1 1 textsize) (vla-SetCellValue vlaTableau 1 1 "Quantité") ;; Lignes de résultat (setq i 0) (setq n (length Resultats)) (setq Total 0.0) (while (< i n) (setq Resultat (nth i Resultats)) (setq row (+ i 2)) ;; BlockName (setq BlockName (strcase (car Resultat))) (vla-SetCellAlignment vlaTableau row 0 acMiddleLeft) (vla-SetCellTextHeight vlaTableau row 0 textsize) (vla-SetCellValue vlaTableau row 0 BlockName) ;; Quantité (setq Total (cdr Resultat)) (vla-SetCellAlignment vlaTableau row 1 acMiddleCenter) (vla-SetCellTextHeight vlaTableau row 1 textsize) (vla-SetCellValue vlaTableau row 1 (rtos Total 2 0)) (setq i (1+ i)) ) ) ;;; PointToVariant ;;; Conversion de Point2D ou Point3D en variant (defun PointToVariant ( point / arraySpace sArray ) (setq arraySpace (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length point))))) (setq sArray (vlax-safearray-fill arraySpace point)) (vlax-make-variant sArray) ) Serge

zebulon_ Effectivement, il faut dessiner le bout de ligne. À preuve, regarde les blocs _DOTBLANK, _Open90 et autres Serge

Bruno, Je ne sais pas ce qui est fait mais voici un bout de code. Il t'aidera peut-être à savoir où ça accroche. Le code fonctionne bien avec des LINE, POLYLINE (AcDb2dPolyline), LWPOLYLINE (AcDbPolyline), 3DPoly (soit POLYLINE - AcDb3dPolyline) et même des surfaces maillées (POLYLINE - "AcDbPolygonMesh") (defun c:SetXdata ( / appName exdata filtre Global i lastent n obj objGet ss ) ;; Insère des données étendues aux objets spécifiés par le filtre ;; Fonctionne en complément de c:GetXdata (setq appName "Nom de l'application") (setq Global t) ; Pour le comportement du ssget: nil pour demander, sinon tout le dessin (setq filtre (list (cons 0 "*polyline,line"))) (if (not (tblsearch "appid" appName)) (regapp appName)) (and (setq ss (if Global (ssget "_x" filtre) (ssget filtre))) (setq n (sslength ss)) (setq i 0) (while (< i n) (setq obj (ssname ss i)) (setq objGet (entget obj (list appName))) (setq exdata (append (list appName) (list (cons 1002 "{")) (list (cons 1000 (strcat "Étiquette chaine à trouver : Handle = " (cdr (assoc 5 objGet))))) (list (cons 1002 "}")) )) (setq exdata (list (list -3 exdata))) (setq objGet (append objGet exdata)) (entmod objGet) (entupd obj) (setq i (1+ i)) ) ) (princ) ) (defun c:GetXdata ( / appName etiquette exdata filtre Global i n obj objGet ss ) ;; Lit des données étendues aux objets spécifiés par le filtre ;; et imprime la valeur de l'étiquette. ;; Fonctionne en complément de c:SetXdata (setq appName "Nom de l'application") (setq Global nil) ; Pour le comportement du ssget: nil pour demander, sinon tout le dessin (setq filtre (list (cons 0 "*polyline,line") (list -3 (list appName)))) (and (setq ss (if Global (ssget "_x" filtre) (ssget filtre))) (setq n (sslength ss)) (setq i 0) (while (< i n) (setq obj (ssname ss i)) (setq objGet (entget obj (list appName))) (setq exdata (cdadr (assoc -3 objGet))) (setq etiquette (cdr (assoc 1000 exdata))) (princ (strcat "\nÉtiquette: " etiquette)) (setq i (1+ i)) ) ) (princ) ) Serge

fabcad Je ne sais pas si tu as eu le temps de regarder le code ou si le fait d'être en VBA était un handicap. Voici une version Lisp. (defun Rename_CategoryName ( OldCategoryName NewCategoryName / CurCategoryName oView oViews thisDrawing ) ;; Renomme les catégorie de vue ;; OldCategoryName peut accepter la plupart des caracères génériques ;; de la commande wcmatch (setq thisDrawing (vla-get-ActiveDocument (vlax-get-acad-object))) (setq oViews (vla-get-Views ThisDrawing)) (setq OldCategoryName (strcase OldCategoryName t)) (vlax-for oView oViews (setq CurCategoryName (strcase (vla-get-CategoryName oView) t)) (if (wcmatch CurCategoryName OldCategoryName) (progn (vla-put-CategoryName oView NewCategoryName) )) ) (vlax-release-object oViews) (setq oViews nil) (princ) ) (defun Exemple_Rename() ;; Renomme les catégories de vues. ;; Paramètre 1: l'ancuien nom (accepte les caractères génériques). ;; Ici tout ce qui commence par S ;; Paramètre 2: le nouveau nom (sans caractères génériques). ;; Ici, le nouveau nom est "NouveauNom" (Rename_CategoryName "s*" "NouveauNom") ) (defun Exemple_Erase() ;; Renomme les catégories de vues. ;; Paramètre 1: l'ancuien nom (accepte les caractères génériques) ;; Paramètre 2: le nouveau nom (sans caractères génériques). Ici, c'est vide (Rename_CategoryName "s*" "") ) Serge

leduj, Est-ce que le problème est réglé ? Si oui, quel était le arx en cause. Toujours si oui, est-ce l'un des fichiers fautif est l'un des verticaux d'AutoCAD ? Si oui, l'approche de lecrabe serait une bonne approche, c'est-à-dire trouver un object enabler approprié sur le site d'Autodesk. Mais pour répondre à ta question, APPLOAD est un utilitaire qui permet de charger ou décharger certaines applications (Arx, VBA et Lisp mais non ce qui est DotNet). Son interface est simple et elle te permet de chosir facilement les routines que tu veux charger automatiquement au démarrage. lecrabe, En effet, c'est une piste logique Patrick_35 Merci pour les mots. Je vais essayer d'être plus assidu. Je reviens d'un pélerinage DotNet. Dans le fond, si ta manip fixe le problème, ce doit être que le problème est aussi lié à l'object enabler. Toujours est-il que si on voulait ne pas démarrer Architecture (ou Autodesk Architectural Desktop, Building ou MEP), on pourrait éviter de lancer AutoCAD avec le raccourci par défaut, lequel utilise un profil et lance une application arx dès la ligne de commande. Par exemple ""C:\Program Files\AutoCAD Architecture 2009\acad.exe" /ld "C:\Program Files\AutoCAD Architecture 2009\AecBase.dbx" /p "AutoCAD Architecture (Métrique)". On pourrait copier le raccourci et dans celui n'avoir que ""C:\Program Files\AutoCAD Architecture 2009\acad.exe"""

Patrick, Si tu veux essayer cet utilitaire gratuit: LTSCale Switch disponible à http://www.cadnovation.com/fr/Prod/ltscale/ltscale.asp "Cet utilitaire résoud un problème majeur rencontré en travaillant avec l'espace papier: Il est difficile d'obtenir des échelles de types de lignes uniformes. En effet, en fixant la variable PSLTSCALE à 1 (Actif) on se doit de fixer la variable LTSCALE à 1. Ceci est quelque peu ennuyeux car au retour à l'espace objet, vous devez restaurer la valeur originale. Le LTSCALE Switch est une application ARX qui automatise ce processus. Il sauvegarde la valeur de la variable LTSCALE en passant de l'espace objet à l'espace papier puis la fixe à 1. Elle restaure l'ancienne valeur au retour. Tout cela en temps réel." Il me fera plaisir de t'envoyer une copie complète gratuite si tu me la demande. Serge

Patrick, La variable LTSCALE est-elle fixée à 1 en espace papier ? Serge

tilte, Il y a plusieurs réponses possibles selon ce que tu as besoin. a) Peux tu contrôler l'affichage avec les calques (du moins, je l'espère) b) Tu peux faire un chargement partiel du dessin. Voir les commandes OUVRPARTIEL et CHARGPARTIEL. Pour donner une idée de OUVRPARTIEL, voici un exemple des questions qui te seaient posées: Commande: OUVRPARTIEL -OUVRPARTIEL Entrez le nom du dessin à ouvrir 2009\Sample\db_samp.dwg>: Entrez la vue à charger ou [?]<*Etendue*>: Entrez calques à charger ou [?]: Décharger toutes les Xréfs à l'ouverture ? [Oui/Non] : Serge