(gile)

Voir ce sujet.

Depuis l'éditeur Visual LISP, tu sélectionnes la fonction dans ton code et tu cliques sur le bouton : [?] ou tu fais Ctrl+F1. Voir section 4.4 de "Introduction à AutoLISP".

Y aurait-il un complot là dessous ?....

Salut, Ça devrait répondre à la demande, mais on pourrait optimiser en faisant la sauvegarde et en modifiant les styles dans la même boucle d'une unique commande STT_All_SHX. On pourrait aussi enregistrer les anciennes valeurs dans le dessin (xdata, ldata, ...). Modification : les styles dépendants de xrefs sont écartés : ;; ;; https://cadxp.com/topic/55909-svp-3-routines-sur-les-styles-de-texte/ ;; ;; Routines: STT_Save___STT_All_SHX___STT_Restore___GC.lsp ;; ;; Routines ecrites par GC (gile) pour Patrice B. ;; Modification 2022-04-30 les styles dépendants des xrefs sont écartés. ;; (defun c:STT_Save (/ file ts) (setq file (open (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) "_STT.csv" ) "w" ) ) (while (setq ts (tblnext "STYLE" (not ts))) (if (zerop (logand (cdr (assoc 70 ts)) 16)) (write-line (strcat (cdr (assoc 2 ts)) ";" (cdr (assoc 3 ts))) file ) ) ) (close file) (princ) ) (defun setfont (style font / ename elist) (and (setq ename (tblobjname "STYLE" style)) (setq elist (entget ename)) (entmod (subst (cons 3 font) (assoc 3 elist) elist)) ) ) (defun c:STT_All_SHX (/ ts shx_police) (setq shx_police "ISOCP.SHX") (while (setq ts (tblnext "STYLE" (not ts))) (if (and (= (strcase (vl-filename-extension (cdr (assoc 3 ts)))) ".TTF" ) (zerop (logand (cdr (assoc 70 ts)) 16)) ) (setfont (cdr (assoc 2 ts)) shx_police) ) ) (command-s "_regenall") (princ) ) (defun c:STT_Restore (/ filename file line style font) (and (setq filename (findfile (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) "_STT.csv" ) ) ) (setq file (open filename "r")) (while (setq line (read-line file)) (setq pos (vl-string-position (ascii ";") line) style (substr line 1 pos) font (substr line (+ pos 2)) ) (if (= (strcase (vl-filename-extension font)) ".TTF") (setfont style font) ) ) ;; (command-s "_regenall") ) (command-s "_regenall") (princ) )

Eh non !... Dans cette routine, c'est un jeu de sélection 'Visual LISP' (type vla-object) qui est assigné à la variable ss et la fonction AutoLISP sssetfirst réclame un jeu de sélection 'AutoLISP' (type pickset). Par ailleurs, il est important de supprimer un jeu de sélection 'Visual LISP' après utilisation (leur nombre est limité dans la session), d'où le (vla-Delete ss). Une routine équivalente en 'pur AutoLISP' : ;; Rotation de N Bloc(s) d'un angle donne (+/- xx.xx) ;; par rapport a leur point d'insertion par GC ;; Commande au clavier : BROT (defun c:brot (/ rot ss i br) (if (and (setq rot (getorient "\nRotation: ")) (setq ss (ssget '((0 . "INSERT")))) ) (repeat (setq i (sslength ss)) (setq br (ssname ss (setq i (1- i)))) (setpropertyvalue br "Rotation" (+ (getpropertyvalue br "Rotation") rot) ) ) ) (sssetfirst nil ss) (princ) )

Salut, Normalement, aucune contre-indication. Mais à mon avis, il n'y a aucune urgence à mettre à jour si Visual Studio 2019 te conviens (personnellement je ne l'ai pas fait), surtout si tu développes pour AutoCAD, donc en ciblant le Framework .NET. Les principales évolutions devraient concerner .NET Core (multiplateforme).

Une autre façon, peut-être plus facile à appréender, pas sûr avec la cascade (apply 'append (mapcar '(lambda ...))). Dans tous les cas, on n'échappe pas à la récursivité. (defun traverse (tree) (apply 'append (mapcar (function (lambda (x) (if (and (cdr x) (atom (cdr x))) (list (cdr x)) (traverse x) ) ) ) tree ) ) )

Pour voir comment "aplatir" un arbre tel que celui-ci, commençons par étudier la structure : chaque branche de l'arbre est une liste qui peut contenir des feuilles (paires pointées) et des branches. on a bien à faire à une structure récursive dont on veut récupérer les feuilles (plus précisément le cdr de chaque feuille). Notre fonction récursive devra donc pourvoir identifier une feuille pour en récupérer le cdr, mais aussi traiter une branche, et bien sûr, avoir une condition d'arrêt pour terminer le traitement. Le traitement récursif des listes consiste le plus souvent à agréger le résultat du traitement du premier élément de la liste (car) au traitement récursif du reste de la liste (cdr). La condition d'arrêt est simple dans ce cas, comme il faut traiter toute la liste, on s'arrête quand celle-ci est vide. Le traitement d'un branche est identique au traitement de l'arbre (récursivité), il suffit donc de passer la branche à un appel récursif de la fonction. Le traitement d'une feuille nécessite de construire la valeur de retour en récupérant le contenu de la feuille pour l'agréger au traitement récursif de reste de la liste. Pour ce faire il faut identifier une feuille à savoir une paire pointée. Une paire pointée est une liste dont le 'cdr' est un atome, mais attention, comme 'nil' 'est aussi un atome, il faut aussi s'assurer que le 'cdr' n'est pas 'nil'. Notre fonction, qui doit renvoyer une liste peut donc être définie comme suit : la liste vide, on renvoie nil ; le premier élément de la liste est une paire pointée, on construit la liste qui sera finalement renvoyée en ajoutant la valeur de la paire pointée avec 'cons' à la liste renvoyée en passant le reste de la liste à l'appel récursif de la fonction ; le premier élément est une branche, on concatène la liste renvoyée par le traitement de la branche avec celle renvoyée par le reste de la liste. (defun flatten (tree) (cond ((null tree) nil) ((and (cdar tree) (atom (cdar tree))) (cons (cdar tree) (flatten (cdr tree)))) (T (append (flatten (car tree)) (flatten (cdr tree)))) ) ) Voyons comment ça fonctionne avec un arbre simple mais significatif quand même. (setq tree '( ( ("*A1" . 1) ) ( ("*A2" . 2) ( ("*A1" . 3) ) ( ("*A2" . 4) ) ) ) ) Description des évaluations dans la phase d'empilement des appels récursif (on évalue toujours le premier appel) : ;; 1 le premier élément est une branche (flatten '((("*A1" . 1)) (("*A2" . 2) (("*A1" . 3)) (("*A2" . 4))))) ;; 2 le premier élément est une feuille (append (flatten '(("*A1" . 1))) (flatten '((("*A2" . 2) (("*A1" . 3)) (("*A2" . 4)))))) ;; 3 le premier élément est vide (append (cons 1 (flatten nil)) (flatten '((("*A2" . 2) (("*A1" . 3)) (("*A2" . 4)))))) ;; 4 le premier élément est une branche (append (cons 1 nil) (flatten '((("*A2" . 2) (("*A1" . 3)) (("*A2" . 4)))))) ;; 5 le premier élément est une feuille (append (cons 1 nil) (append (flatten '(("*A2" . 2) (("*A1" . 3)) (("*A2" . 4))) (flatten nil)))) ;; 6 le premier élément est une branche (append (cons 1 nil) (append (cons 2 (flatten '((("*A1" . 3)) (("*A2" . 4))))) (flatten nil))) ;; 7 le premier élément est une feuille (append (cons 1 nil) (append (cons 2 (append (flatten '(("*A1" . 3))) (flatten '((("*A2" . 4)))))) (flatten nil))) ;; 8 le premier élément est vide (append (cons 1 nil) (append (cons 2 (append (cons 3 (flatten nil)) (flatten '((("*A2" . 4)))))) (flatten nil))) ;; 9 le premier élément est une branche (append (cons 1 nil) (append (cons 2 (append (cons 3 nil) (flatten '((("*A2" . 4)))))) (flatten nil))) ;; 10 le premier élément est une feuille (append (cons 1 nil) (append (cons 2 (append (cons 3 nil) (append (flatten '(("*A2" . 4))) (flatten nil)))) (flatten nil))) ;; 11 le premier élément est vide (append (cons 1 nil) (append (cons 2 (append (cons 3 nil) (append (cons 4 (flatten nil)) (flatten nil)))) (flatten nil))) ;; 12 le premier élément est vide (append (cons 1 nil) (append (cons 2 (append (cons 3 nil) (append (cons 4 nil) (flatten nil)))) (flatten nil))) ;; 13 le premier élément est vide (append (cons 1 nil) (append (cons 2 (append (cons 3 nil) (append (cons 4 nil) nil))) (flatten nil))) ;; fin des appels récursifs, dépilement (append (cons 1 nil) (append (cons 2 (append (cons 3 nil) (append (cons 4 nil) nil))) nil))

Oui. Il faut jouer sur le code binaire 1 du groupe DXF 70 (voir l'aide, comme toujours). Pour faire une bascule Geler/Libérer, on peut utiliser la fonction boole (voir l'aide, encore). Pour jouer avec les codes binaires et les opérations de bit à bit, voir ce sujet. (defun C:K (/ dxf flags) (and (setq dxf (entget (tblobjname "LAYER" "moncalque"))) (setq flags (assoc 70 dxf)) (entmod (subst (cons 70 (boole 6 (cdr flags) 1)) flags dxf)) ) (princ) )

Mais ils ne l'ont pas fait dans le PGP...

Je vais essayer une dernière fois de me faire comprendre. Tu utilises déjà très certainement des procédures Function natives, comme par exemple la méthode Add qui permet d'ajouter un élément une collection. On peu très bien utilise une procédure Function comme si c'était une procédure Sub en ignorant la valeur de retour. Par exemple pour créer un nouveau calque et lui affecter la couleur rouge (ACI 1) en ignorant la valeur renvoyée par la méthode Add (un objet AcadLayer dans ce cas). ' on déclare une variable Dim calque As AcadLayer ' on crée un nouveau calque ThisDrawing.Layers.Add("TOTO") ' on retrouve ce calque pour l'affecter à la variable newLayer = ThisDrawing.Layers.Item("TOTO") ' on affecte une couleur au calque newLayer.Color = 1 Mais il est plus simple d'utiliser directement la valeur renvoyée par Add (et c'est probablement ce que tu fais). ' on déclare une variable Dim calque As AcadLayer ' on crée un nouveau calque et on l'affecte à la variable Set calque = ThisDrawing.Layers.Add("TOTO") ' on affecte une couleur au calque newLayer.Color = 1 C'est exactement la même chose avec les procédure que tu crées. Pour créer un premier filtre de calque, on a besoin d'une utiliser une procédure. Pour créer un sous-filtre de calque, enfant du premier, il faut un procédure un peu différente de la première qui a besoin de "connaitre" le filtre de calque parent. En utilisant une procédure Sub, je peux très bien créer mon premier filtre calque, mais pour créer un sous-filtre il va falloir que je retrouve ce filtre d'une manière ou d'une autre. Si j'utilise une procédure Function en tout point similaire à la procédure Sub si ce n'est qu'en plus elle renvoie le filtre créé, et je vais pouvoir utiliser directement cette valeur de retour pour créer le sous-filtre, sans avoir besoin de parcourir tous les filtres ou d'utiliser un stockage externe à la procédure pour la retrouver. Il en va de même pour la création des sous-filtres.

Tu as raison de dire que tu as tord, et ce n'est pas parce que tu as appris des mauvaises manières qu'il ne faut pas en changer... La différence entre une procédure Sub et une procédure Function est simplement que la première exécute une action sans renvoyer de valeur et que la seconde renvoie toujours une valeur. MsgBox, par exemple est une procédure Function qui renvoie nombre entier correspondant au bouton cliqué pour fermer la boite. Dans le cas qui nous occupe, pour créer un sous-filtre de calque, il faut connaitre le filtre de calque "parent". Avec une procédure Sub, on peut très bien créer un filtre de calque, mais le filtre créé n'est connu que de cette procédure (puisqu'elle ne renvoie rien) à moins d'utiliser un "effet de bord", en utilisant une variable globale, par exemple. Par contre, utiliser une procédure Function pour créer un filtre de calque permet de renvoyer le filtre nouvellement créé par la procédure. Ceci permet de simplifier le code qui utilise cette fonction et surtout de le rendre plus robuste (plus facile à déboguer et à maintenir). Dans l'exemple que j'ai donné, les procédures "CreaFiltrePrefixe" et "CreaSousFiltre" renvoient le filtre de calque créé. Ceci qui permet à la fois de créer un filtre et de récupérer directement ce filtre dans une variable pour pouvoir éventuellement le passer en argument à un nouvel appel de "CreaSousFiltre" pour créer un filtre "enfant" du filtre nouvellement créé. Set Filtre = CreaFiltrePrefixe("Filtre1", "[1-9]*") Set SousFiltre1 = CreaSousFiltre(Filtre, "Filtre2", "FROZEN==""False""") Set SousFiltre2 = CreaSousFiltre(SousFiltre1, "Filtre3", "COLOR==""1""") Alors s'il te plait, essaye le code que j'ai posté plus haut et s'il crée bien un premier filtre pour tous les calques dont le nom commence par un chiffre (sauf 0), puis un sous filtre de celui-ci pour les claques qui ne sont pas gelés et enfin un sous filtre de ce dernier pour les claques de couleur rouge, tu n'as qu'à modifier la procédure SUB "Test" pour l'adapter à tes besoins : Public Sub Test() Dim Rdc As Object Dim RdcCoupes As Object Dim RdcCoupesCloisons As Object Dim RdcCoupesMurs As Object ' création du filtre de calque "Rdc" et stockage du filtre dans la variable "Rdc" Set Rdc = CreaFiltrePrefixe("Rdc", "Rdc*") ' création du sous-filtre de calque "RdcCoupes" et stockage du filtre dans la variable "RdcCoupes" Set RdcCoupes = CreaSousFiltre(Rdc, "Rdc-Coupes", "NAME==""Rdc-Coupes*""") ' création du sous-filtre de calque "RdcCoupesCloisons" et stockage du filtre dans la variable "RdcCoupesCloisons" ' au cas où on voudrait créer des sous-filtres de celui-ci Set RdcCoupesCloisons = CreaSousFiltre(RdcCoupes, "Rdc-Coupes-Cloisons", "NAME==""Rdc-Coupes-Cloisons*""") ' création du sous-filtre de calque "RdcCoupesMurs" et stockage du filtre dans la variable "RdcCoupesMurs" ' au cas où on voudrait créer des sous-filtres de celui-ci Set RdcCoupesMurs = CreaSousFiltre(RdcCoupes, "Rdc-Coupes-Murs", "NAME==""Rdc-Coupes-Murs*""")

As-tu essayé le code que j'ai donné plus haut ?

Je n'ai pas dit que tu ne pouvais pas le faire, je trouve ça juste un peu cavalier.

Alors tu vends à ton client une routine LISP gracieusement offerte par son auteur que tu souhaites faire modifier gratuitement par les membres du forum...

Salut, F12 (saisie dynamique)

(defun c:scalehatch (/ ss scl i hach) (prompt "\nSélectionnez les hachures (ou Entrée pour toutes).") (if (and (or (setq ss (ssget '((0 . "HATCH") (2 . "~SOLID")))) (setq ss (ssget "_X" '((0 . "HATCH") (2 . "~SOLID")))) ) (progn (initget 6) (or (setq scl (getreal "\nEntrez le factuer d'achelle <2.0>: ")) (setq scl 2.0) ) ) ) (repeat (setq i (sslength ss)) (setq hach (ssname ss (setq i (1- i)))) (setpropertyvalue hach "PatternScale" (* scl (getpropertyvalue hach "PatternScale"))) ) ) (princ) )

Salut, La commande EDITHACH (_HATCHEDIT) appelée en LISP ne traite qu'une hachure à la fois, il faut donc parcourir le jeu de sélection pour traiter chaque hachure. (defun c:test (/ js i) (if (setq js (ssget "_X" (list (cons 0 "HATCH")))) (progn (repeat (setq i (sslength js)) (command "_hatchedit" (ssname js (setq i (1- i))) "" "_properties" "" 4 "") ) ) ) (princ) )

Tu n'as pas besoin d'installer de Framework. Les DLLs en local et correctement débloquées (re-télécharge les au besoin), ça devrait marcher.

D'après le message d'erreur, ça ressemble bien à un problème de déblocage des DLLs ou que les DLLs ne sont pas en local sur le poste. Dans tous les cas, installer .NET Core ne sert à rien, les DLLs utilisent .NET Framework.

J'ai un peu regardé (ça faisait longtemps que je n'avais pas joué avec les filtres de calque). Pour pouvoir créer des sous filtres, il faut partir d'un Xrecord dans le dictionnaire "ACLYDICTIONARY" du filtre parent. Il faut donc créer cette entrée quand on crée le filtre à la "racine" de notre arbre et le faire dans une Function pour renvoyer ce Xrecord. On peut ensuite créer une autre Function pour créer un sous filtre qui renverra le sous filtre nouvellement créé pour pouvoir éventuellement lui ajouter un sous filtre, etc. Un exemple (pas testé) avec une méthode de test qui crée un premier filtre pour tous les calques dont le nom commence par un chiffre (sauf 0), puis un sous filtre de celui-ci pour les claques remplissant la première propriété et qui ne sont pas gelés et enfin un sous filtre de ce dernier pour les claques de couleur rouge. Public Function CreaFiltrePrefixe(NomFiltre As String, Modele As String) As Object Dim XDict As Object Dim Dict1 As Object Dim Dict2 As Object Dim Xrec1 As Object Dim Data1Type(0 To 6) As Integer Dim Data1Value(0 To 6) As Variant Dim XdataType(0 To 1) As Integer Dim XdataValue(0 To 1) As Variant Dim Data2Type(0 To 4) As Integer Dim Data2Value(0 To 4) As Variant ' création du filtre dans "ACAD_LAYERFILTERS" Set XDict = ThisDrawing.Layers.GetExtensionDictionary Set Dict1 = XDict.AddObject("ACAD_LAYERFILTERS", "AcDbDictionary") Set Xrec1 = Dict1.AddXRecord(NomFiltre) Data1Type(0) = 1: Data1Value(0) = NomFiltre Data1Type(1) = 1: Data1Value(1) = Modele Data1Type(2) = 1: Data1Value(2) = "*" Data1Type(3) = 1: Data1Value(3) = "*" Data1Type(4) = 70: Data1Value(4) = 0 Data1Type(5) = 1: Data1Value(5) = "*" Data1Type(6) = 1: Data1Value(6) = "*" Xrec1.SetXRecordData Data1Type, Data1Value XdataType(0) = 1001: XdataValue = "ACAD" XdataType(1) = 1000: XdataValue = NomFiltre Xrec1.SetXdata XdataType, XdataValue ' création du filtre dans "ACLYDICTIONARY" Set Dict2 = XDict.AddObject("ACLYDICTIONARY", "AcDbDictionary") Set Xrec2 = Dict2.AddXRecord("*") Data2Type(0) = 290: Data2Value(0) = 1 Data2Type(1) = 1: Data2Value(1) = "AcLyLayerFilter" Data2Type(2) = 90: Data2Value(2) = 1 Data2Type(3) = 300: Data2Value(3) = NomFiltre Data2Type(4) = 301: Data2Value(3) = "NAME==""" & Modele & """" Xrec2.SetXRecordData(Data2Type, Data2Value) ' valeur renvoyée CreaFiltrePrefixe = Xrec2 End Function Public Function CreaSousFiltre(Filtre As Object, NomFiltre As String, Regle As String) As Object Dim XDict As Object Dim Dict As Object Dim Xrec As Object Dim DataType(0 To 4) As Integer Dim DataValue(0 To 4) As Variant Set XDict = Filtre.GetExtensionDictionary Set Dict = XDict.AddObject("ACLYDICTIONARY", "AcDbDictionary") Set Xrec = Dict.AddXRecord("*") DataType(0) = 290: DataValue(0) = 1 DataType(1) = 1: DataValue(1) = "AcLyLayerFilter" DataType(2) = 90: DataValue(2) = 1 DataType(3) = 300: DataValue(3) = NomFiltre DataType(4) = 301: DataValue(3) = Regle Xrec.SetXRecordData DataType, DataValue ' valeur renvoyée CreaSousFiltre = Xrec End Function ' Test crée un filtre pour les calques dont le nom commence par un chiffre sauf 0, ' qui contient un sous filtre pour les calques non-gelés ' qui contient un sous filtre pour les calques de couleur rouge Public Sub Test() Dim Filtre As Object Dim SousFiltre1 As Object Dim SousFiltre2 As Object Set Filtre = CreaFiltrePrefixe("Filtre1", "[1-9]*") Set SousFiltre1 = CreaSousFiltre(Filtre, "Filtre2", "FROZEN==""False""") Set SousFiltre2 = CreaSousFiltre(SousFiltre1, "Filtre3", "COLOR==""1""")

Salut, Regarde ce sujet et celui-là.

Salut, Petite remarque concernant l'azimut (ou longitude en coordonnées sphériques). Pour avoir une valeur dans l'intervalle [0, 2*PI], il faut soit prendre en considération la valeur de X (CF Conversion entre système polaire et cartésien) ; soit utiliser une fonction acceptant 2 arguments : (atan Y X) en LISP ou atan2(Y, X) dans de nombreux autres langages.

Salut, On parle bien de LISP ? Pour ouvrir un fichier avec l'application par défaut en spécifiant le chemin complet ou juste le nom du fichier s'il est dans les chemins de recherche (avec gestion d'erreur). (defun OpenFileWithDefaultApp (filename / shellApp) (and (setq filename (findfile filename)) (setq shellApp (vlax-create-object "Shell.Application")) (vl-catch-all-apply 'vlax-invoke (list shellApp 'Open filename)) (vlax-release-object shellApp) ) )

Salut, Ce message veut dire que l'expression attends une chaine (stringp) mais reçoit un nom d'entité ou ename (<Nom d'entité: 1f48fb16930>). Pour trouver d'où vient une erreur, je rappelle l'utilisation des fonction "Arrêt sur erreur" et "Source de la dernière interruption" du menu "Débogage" de l'éditeur Visual LISP. Voit ce screencast.