(gile)

@val35 Salut et bienvenue. Il s'agit d'un code AutoLISP. Pour le charger et l'exécuter voir ce sujet.

Salut, Depuis plusieurs versions (?) le module VBA d'AutoCAD doit être téléchargé et installé séparément. Voir ici.

Il s'agit de fonctions LISP, pas de commandes définies en LISP. Elles s'utilisent comme les fonctions natives en leur passant les arguments requis (lis les commentaires en en-tête). Par exemple, pour récupérer tout le contenu de la feuille courante du fichier C:\Temp\toto.xls, tu fais : (gc:ReadExcel "C:\\Temp\\toto.xls" nil nil "*") pour récupérer le contenu de la feuille courante depuis la cellule "A2" jusqu'à la fin de la plage : (gc:ReadExcel "C:\\Temp\\toto.xls" nil "A2" nil) pour récupérer le contenu de la feuille nommée "PropDess" depuis la cellule "A2" jusqu'à la cellule "E3" : (gc:ReadExcel "C:\\Temp\\toto.xls" "PropDess" "A2" "E3") Attention, dans tous les cas, AutoCAD va se figer le temps de démarrer un processus Excel (s'il n'y en pas déjà un de lancé) avant de renvoyer une liste de sous listes (une sous-liste par rangée). Il est donc préférable, s'il y a plusieurs requêtes à faire, de récupérer tout le contenu de la feuille et de traiter las liste renvoyée ensuite.

Salut, Le fait que 'nil' s'affiche sur la ligne commande est dû au fait que j'ai oublié un (princ) en fin de routine pour une 'sortie silencieuse', mais cela ne devrait en aucun cas altérer le fonctionnement. J'ai corrigé le code sur gileCAD.

Salut, Je pensais avoir déjà postées ces routines sur CADxp, mais je ne les retrouve pas. ;;------------------------------------------------------------------------------- ;; gc:WriteExcel ;; Ecrit dans un fichier Excel ;; ;; Arguments : 4 ;; filename : chemin complet du fichier ;; sheet : nom de la feuille (ou nil pour la feuille courante) ;; startRange : nom de la cellule de départ (ou nil pour "A1") ;; dataList : liste de sous-listes contenant les données (une sous liste par rangée) ;;------------------------------------------------------------------------------- (defun gc:WriteExcel (filename sheet startRange dataList / *error* xlApp wBook save sheets active start row col cells n cell ) (vl-load-com) (defun *error* (msg) (and msg (/= msg "Fonction annulée") (princ (strcat "\nErreur: " msg)) ) (and wBook (vlax-invoke-method wBook 'Close :vlax-False)) (and xlApp (vlax-invoke-method xlApp 'Quit)) (and reg (vlax-release-object reg)) (mapcar (function (lambda (obj) (and obj (vlax-release-object obj)))) (list cell cells wBook xlApp) ) (gc) ) (setq xlapp (vlax-get-or-create-object "Excel.Application")) (if (findfile filename) (setq wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Open filename) save T ) (setq wBook (vlax-invoke-method (vlax-get-property xlapp 'WorkBooks) 'Add)) ) (if sheet (progn (setq sheets (vlax-get-property xlApp 'Sheets)) (vlax-for s sheets (if (= (strcase (vlax-get-property s 'Name)) (strcase sheet)) (progn (vlax-invoke-method s 'Activate) (setq active T) ) ) ) (or active (vlax-put-property (vlax-invoke-method sheets 'Add) 'Name sheet) ) ) ) (if startRange (setq start (gc:ColumnRow startRange) col (car start) row (cadr start) ) (setq col 1 row 1 ) ) (setq cells (vlax-get-property xlApp 'Cells)) (or startRange (vlax-invoke-method cells 'Clear)) (foreach sub dataList (setq n col) (foreach data sub (setq cell (vlax-variant-value (vlax-get-property cells 'Item row n))) (if (= (type data) 'STR) (vlax-put-property cell 'NumberFormat "@") ) (vlax-put-property cell 'Value2 data) (setq n (1+ n)) ) (setq row (1+ row)) ) (vlax-invoke-method (vlax-get-property (vlax-get-property xlApp 'ActiveSheet) 'Columns ) 'AutoFit ) (if save (vlax-invoke-method wBook 'Save) (if (and (< "11.0" (vlax-get-property xlapp "Version")) (= (strcase (vl-filename-extension filename) T) ".xlsx") ) (vlax-invoke-method wBook 'SaveAs filename 51 "" "" :vlax-false :vlax-false 1 1) (vlax-invoke-method wBook 'SaveAs filename -4143 "" "" :vlax-false :vlax-false 1 1) ) ) (*error* nil) ) ;;------------------------------------------------------------------------------- ;; gc:ReadExcel ;; Retourne une liste de sous-listes contenant les données (une sous liste par rangée) ;; d'un fichier Excel ;; ;; Arguments : 4 ;; filename : chemin complet du fichier ;; sheet : nom de la feuille (ou nil pour la feuille courante) ;; startRange : nom de la cellule de départ (ou nil pour "A1") ;; maxRange : nom de la cellule où doit s'arrêter la lecture, ;; ou "*" pour toute la feuille, ou nil ou "" pour la région courante ;;------------------------------------------------------------------------------- (defun gc:ReadExcel (filename sheet startRange maxRange / *error* xlApp wBook wSheet startCell startCol startRow maxCell maxCol maxRow reg cells col row data sub lst ) (defun *error* (msg) (and msg (/= msg "Fonction annulée") (princ (strcat "\nErreur: " msg)) ) (and wBook (vlax-invoke-method wBook 'Close :vlax-False)) (and xlApp (vlax-invoke-method xlApp 'Quit)) (mapcar (function (lambda (obj) (and obj (vlax-release-object obj)))) (list reg cells wSheet wBook xlApp) ) (gc) ) (setq xlapp (vlax-get-or-create-object "Excel.Application") wBook (vlax-invoke-method (vlax-get-property xlApp 'WorkBooks) 'Open filename) ) (if sheet (vlax-for ws (vlax-get-property xlapp 'Sheets) (if (= (vlax-get-property ws 'Name) sheet) (vlax-invoke-method (setq wSheet ws) 'Activate) ) ) (setq wSheet (vlax-get-property wBook 'ActiveSheet)) ) (if startRange (setq startCell (gc:ColumnRow startRange) startCol (car startCell) startRow (cadr startCell) ) (setq startRange "A1" startCol 1 startRow 1 ) ) (if (and maxRange (setq maxCell (gc:ColumnRow maxRange))) (setq maxCol (1+ (car MaxCell)) maxRow (1+ (cadr MaxCell)) ) (setq reg (if (= maxRange "*") (vlax-get-property wSheet 'UsedRange) (vlax-get-property (vlax-get-property wSheet 'Range startRange) 'CurrentRegion ) ) maxRow (+ (vlax-get-property reg 'Row) (vlax-get-property (vlax-get-property reg 'Rows) 'Count) ) maxCol (+ (vlax-get-property reg 'Column) (vlax-get-property (vlax-get-property reg 'Columns) 'Count) ) ) ) (setq cells (vlax-get-property xlApp 'Cells) row maxRow ) (while (< startRow row) (setq sub nil col maxCol row (1- row) ) (while (< startCol col) (setq col (1- col) sub (cons (vlax-variant-value (vlax-get-Property (vlax-variant-value (vlax-get-property cells 'Item row col)) 'Value2 ) ) sub ) ) ) (setq lst (cons sub lst)) ) (*error* nil) lst ) ;;------------------------------------------------------------------------------- ;; gc:ColumnRow - Retourne une liste des indices de colonne et rangée ;; Arguments: 1 ;; Cell = Référence de la cellule ;; Exemple de syntaxe : (gc:ColumnRow "IV987") -> (256 987) ;;------------------------------------------------------------------------------- (defun gc:ColumnRow (cell / col char row) (setq col "") (while (< 64 (ascii (setq char (strcase (substr cell 1 1)))) 91) (setq col (strcat col char) cell (substr cell 2) ) ) (if (and (/= col "") (numberp (setq row (read Cell)))) (list (gc:Alpha2Number col) row) ) ) ;;------------------------------------------------------------------------------- ;; gc:Alpha2Number - Convertit une chaîne alphabétique en nombre entier ;; Function By: Gilles Chanteau from Marseille, France ;; Arguments: 1 ;; str = Chaîne à convertir ;; Exemple de syntaxe : (gc:Alpha2Number "BU") = 73 ;;------------------------------------------------------------------------------- (defun gc:Alpha2Number (str / num) (if (= 0 (setq num (strlen str))) 0 (+ (* (- (ascii (strcase (substr str 1 1))) 64) (expt 26 (1- num)) ) (gc:Alpha2Number (substr str 2)) ) ) ) ;;------------------------------------------------------------------------------- ;; gc:Number2Alpha - Convertit un nombre entier en chaîne alphabétique ;; Function By: Gilles Chanteau from Marseille, France ;; Arguments: 1 ;; num = Nombre à convertir ;; Exemple de syntaxe : (gc:Number2Alpha 73) = "BU" ;;------------------------------------------------------------------------------- (defun gc:Number2Alpha (num / val) (if (< num 27) (chr (+ 64 num)) (if (= 0 (setq val (rem num 26))) (strcat (gc:Number2Alpha (1- (/ num 26))) "Z") (strcat (gc:Number2Alpha (/ num 26)) (chr (+ 64 val))) ) ) )

Je ne comprends pas ce que tu veux dire par "solution automatique". DWGPREFIX renvoie le dossier dans lequel le fichier a été enregistré ce chemin est donc bien "écrit en dur" au moment où tu enregistres le dessin. Pour le déploiement d'applications, Autodesk offre, depuis la version 2012, le mécanisme Autoloader qui permet de charger automatiquement des applications (LISP, .NET, ObjectARX), des fichiers de personnalisation (CUIX), de déclarer des chemins de recherche, et depuis quelques verions, de définir des variables système. Voir ce sujet complet (en anglais) ou les paragraphes liés à Autoloader dans celui-là plus succins (en français).

Le problème avec ton code, c'est que tu ajoutes les références d'attribut avec la commande ATTSYNC que tu lances avec SendStringToExecute qui est asynchrone (la commande n'est exécutée qu'a la fin de la méthode). Tu peux ajouter explicitement les attributs comme dans le code de la documentation. private void CoteAlti(Database db, BlockTable bt, BlockTableRecord owner, Transaction tr, double x, double y, double alt, int inf) { BlockReference blocCoteAlti; if (inf == 1) blocCoteAlti = new BlockReference(new Point3d(x, y, 0), bt["COT-altimétrie-inf"]); else blocCoteAlti = new BlockReference(new Point3d(x, y, 0), bt["COT-altimétrie"]); using (blocCoteAlti) { blocCoteAlti.TransformBy(Matrix3d.Scaling(500, new Point3d(x, y, 0))); owner.AppendEntity(blocCoteAlti); tr.AddNewlyCreatedDBObject(blocCoteAlti, true); // ajout des références d'attribut var btr = (BlockTableRecord)tr.GetObject(blocCoteAlti.BlockTableRecord, OpenMode.ForRead); bool first = true; foreach (ObjectId id in btr) { if (id.ObjectClass.DxfName == "ATTDEF") { var attDef = (AttributeDefinition)tr.GetObject(id, OpenMode.ForRead); if (!attDef.Constant) { var attRef = new AttributeReference(); attRef.SetAttributeFromBlock(attDef, blocCoteAlti.BlockTransform); if (first) attRef.TextString = alt.ToString(); first = false; owner.AppendEntity(attRef); tr.AddNewlyCreatedDBObject(attRef, true); } } } } }

Regarde les fonctions setenv et getenv qui permettent d'écrire et de lire facilement une valeur de type chaîne dans : HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\RXX.X\ACAD-XXXX:XXX\FixedProfile\General

Salut, Dans la mesure où tu ne peux pas utiliser le serveur comme stockage unique pour tous les postes, pourquoi ne pas utiliser le même chemin en local pour tous les postes ?

Salut, En .NET (comme en AutoLISP avec entmake), il revient au programme de créer explicitement les références d'attribut liée à la référence de bloc insérée. Tu peux voir ce sujet de la documentation du développeur.

Salut, Voir ce sujet sur TheSwamp.

Je suis retombé sur ce LISP écrit il y a plus de 10 ans qui fait un zoom sur les objets dont les handles sont spécifiés par l'utilisateur. Si ça peut aider. Par contre, il y a plus de deux trois lignes de code...

D'accord merci. J'ai bien utilisé ces fonctionnalités (issues d'Inventor sur lequel elles existent depuis longtemps), mais je n'avais jamais eu besoin de leur nom DXF. Ceci-dit, ton problème soulève une bizarrerie,(ssget "_X" '((0 . "DRAWINGVIEW"))) entré en ligne commande fonctionne bien, mais ne fonctionne pas quand il est appelé depuis une routine LISP. De plus, la fonction entmod semble ne pas fonctionner avec ce type d'entité (comme elle ne fonctionne pas avec les entités VIEWPORT). Je te propose donc une façon différente qui parcourt toutes les entités du dessin avec entnext et qui utilise getpropertyvalue pour changer le calque. (defun c:DWGVIEWLAYER (/ layerId ent) (setq layerId (cond ((tblobjname "layer" "MD_Annotation")) ((entmakex '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "MD_Annotation") (70 . 0) ) ) ) ) ent (entnext) ) (while ent (if (= (cdr (assoc 0 (entget ent))) "DRAWINGVIEW") (setpropertyvalue ent "LayerId" layerId) ) (setq ent (entnext ent)) ) (princ) )

Salut, As-tu essayé avec des guillemets ? (0 . "DRAWINGVIEW") Par curiosité, quel AutoCAD utilises-tu ? Je ne connaissais pas ces entités DRAWINGVIEW.

OK, la confusion vient de ce qu'on entend par : "point de départ". Le "point de départ" spécifié par l'utilisateur lors de l'exécution de la commande ARC ne correspond pas forcément à la valeur de la propriété StartPoint. Celle-ci est déterminée par AutoCAD lors de l'ajout de l'entité Arc dans la base données en fonction de la géométrie de l'arc : StartPoint est toujours le point de départ de l'arc en sens anti-horaire (trigonométrique) en fonction de la normale de l'arc quel que soit l'ordre dans lequel les points ont été spécifiés par l'utilisateur. Donc pour ton problème, il s'agit de trouver un moyen non-équivoque de déterminer l'extrémité de l'arc qui t'intéresse, c'est pourquoi je proposais d'utiliser la méthode de la position du point cliqué, utilisée par de nombreuses commandes AutoCAD (PROLONGER, AJUSTER, MODIFLONG, etc...)

C'est ça. Dans la routine originale, si on choisit une autre branche de l'arborescence, le schéma de la descendance de la branche première branche est conservé, même s'il n'a pas d'équivalent dans la nouvelle branche. Dans ce que tu décris,tu choisis C/C3/C3a/C3aa, soit en utilisant les indices des branches : (2 2 0 0) mais en choisissant ensuite la branche A (index 0), la routine conservait le reste de la liste soit (0 2 0 0) or, la branche A n'a que deux sous-branches (indice 0 et 1) d'où l'erreur. La correction que j'ai fait remet tous les indices descendant de la branche changée à 0 ce qui m'a semblé pertinent.

Qu'appelles tu "point de départ" ?

Mais ce n'est pas pour autant que tu n'en changeras pas avant longtemps ;)

Salut, Un arc est toujours en sens anti-horaire. Sans savoir exactement ce que tu souhaites faire, une façon serait de reproduire ce que font certaines commande AutoCAD pour déterminer l'extrémité d"un objet curviligne en fonction du point cliqué (PickedPoint). Dans ce cas, on choisirait l'extrémité la plus proche du point cliqué. [CommandMethod("TEST")] public void CerleArc() { var doc = Application.DocumentManager.MdiActiveDocument; var db = doc.Database; var ed = doc.Editor; var options = new PromptEntityOptions("\nSélectionner un arc"); options.SetRejectMessage("\nL'objet séléctionné n'est pas un arc"); options.AddAllowedClass(typeof(Arc), false); var result = ed.GetEntity(options); if (result.Status != PromptStatus.OK) return; using (var tr = db.TransactionManager.StartTransaction()) { var arc = (Arc)tr.GetObject(result.ObjectId, OpenMode.ForRead); var point = result.PickedPoint.TransformBy(ed.CurrentUserCoordinateSystem); var center = arc.EndPoint.DistanceTo(point) < arc.StartPoint.DistanceTo(point) ? arc.EndPoint : arc.StartPoint; var cSpace = (BlockTableRecord)tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite); var circle = new Circle(center, Vector3d.ZAxis, 7.0); cSpace.AppendEntity(circle); tr.AddNewlyCreatedDBObject(circle, true); tr.Commit(); } }

Salut, Juste pour faire mentir didier (qui a néanmoins raison en disant que le mieux est de contacter l'auteur). Remplace la fonction LM:substnth par : (defun LM:substnth (itm idx lst) (if lst (if (zerop idx) (cons itm (mapcar '(lambda (x) 0) (cdr lst))) (cons (car lst) (LM:substnth itm (1- idx) (cdr lst))) ) ) )

Salut, On parle bien de LISP ici. On peut, bien sûr utiliser des expressions LISP dans les macros de commande et dans les scripts comme on peut les entrer directement en ligne de commande. Ici, l'expression LISP serait: (sssetfirst nil (ssget "X" '((0 . "TEXT,MTEXT"))))qu'on peut mettre dans une macro de commande en la faisant précéder par ^C^C pour garantir l'annulation de toute commande en cours. PS: la fonction sssetfirst est documentée en français sur da-code (le site de didier) et dans Introduction à AutoLISP (section 16.3)

La demande n'était pas, il me semble, tout à fait identique. Quant il s'agit d'obtenir ou de définir la valeur d'un attribut d'après son étiquette, les fonctions getpropertyvalue et setpropertyvalue sont tout à fait adaptées. Mais dfbiagio demandait : "Comment faire pour extraire les valeurs des attributs un à un.", et pour parcourir tous les attributs, la fonction entnext est plus adaptée.

Salut, La fonction entnext renvoie l'entité qui, dans la base de données, suit celle passée qui est en argument. Si une référence de bloc contenant des attributs est passée en argument à entnext, la fonction retourne le premier attribut. De même, si on passe cet attribut en argument à entnext, celle-ci renverra l'attribut suivant ou un objet SEQEND s'il n'y a plus d'attributs. On utilise donc une boucle avec while tant que l'objet renvoyé par entnext est bien un attribut. ;; sélectionner un bloc (setq bloc (car (entsel "\nSélectionnez une référence de bloc: "))) ;; récupérer la liste des données DXF de l'entité sélectionnée (setq elst (entget bloc)) ;; contrôler la validité de l'entité sélectionnée (cond ((/= (cdr (assoc 0 elst)) "INSERT") (alert "L'entité sélectionnée n'est pas un bloc.") ) ((null (assoc 66 elst)) (alert "Le bloc sélectionné n'a pas d'attributs.") ) (T ;; récupérer l'entité suivant le bloc sélectionné dans la base de données (setq att (entnext bloc)) ;; boucler tant que cette entité est une référence d'attribut (while (= (cdr (assoc 0 (setq elst (entget att)))) "ATTRIB") (alert (strcat (cdr (assoc 2 elst)) " = " (cdr (assoc 1 elst)))) ;; récupérer l'entité suivant l'attribut dans la base de données (setq att (entnext att)) ) ) )

Salut, Je n'ai jamais fait ce que tu cherches à faire, mais il y a peut-être une piste avec un "vieux" truc que j'avais essayé, un bout de code de Fenton Webb pour afficher dans un contrôle une prévisualisation d'un bloc : BlockView.NET Voir ce sujet : https://www.keanw.com/2008/06/autocad-net-ver.html et celui-là : https://forums.autodesk.com/t5/net/blockview-net/td-p/3649752

Pour résumer, ne jamais perdre de vue qu'une routine LISP retourne toujours une valeur, fusse-t-elle nil ou un symbole vide (invisible dans ce cas). Mais ne pas oublier non plus que certaines fonctions ont aussi un effet de bord. (princ 20) renvoie bien 20 mais après avoir inscrit 20 sur la ligne de commande. Un exemple qui reproduit ce que tu décris: (defun c:commande (/ resultat) (setq resultat (routine1 10)) (princ (strcat "Resultat 1 = " (rtos resultat 2 2))) (terpri) (setq resultat (routine2 20)) (princ (strcat "Resultat 2 = " (rtos resultat 2 2))) (princ) ) (defun routine1 (arg) (+ 20 arg) ) (defun routine2 (arg) (princ (+ 20 arg)) ; <- inscrit "20" et renvoie 20 )