(gile)

Salut et bienvenue, Essaye comme ça: (defun sort-list (l / compare) (defun compare (x y) (cond ((and (numberp (read x)) (numberp (read y))) (< x y)) ((numberp (read x)) nil) ((numberp (read y)) T) ((= (strlen x) (strlen y)) (< x y)) (T (< (strlen x) (strlen y))) ) ) (vl-sort l '(lambda (x y) (if (= (car x) (car y)) (compare (cadr x) (cadr y)) (compare (car x) (car y)) ) ) ) )

Il semble que ce soit pas complètement réglé (CF cette réponse).

Salut, Quelle version d'AutoCAD utilises-tu ? Les installeurs viennent-ils de Autodesk App Store ? Si oui, est-ce que tu les vois dans l'onglet Compléments du ruban (anciennement Plug-ins) ?

Oupss!... Une ligne avait sauté. (defun c:manu_CAD (/ blk ent elst) (while (setq blk (tblnext "block" (not blk))) (setq ent (cdr (assoc -2 blk))) (while ent (setq elst (entget ent)) (entmod (subst (cons 8 "ELEC") (assoc 8 elst) elst)) (setq ent (entnext ent)) ) (command-s "_.attsync" "_name" (cdr (assoc 2 blk))) ) (princ) )

Non, il y a toujours la boite de dialogue. Pour mettre toutes les entités des tous les blocs sur le calque "ELEC" : (defun c:manu_CAD (/ blk ent elst) (while (setq blk (tblnext "block" (not blk))) (setq ent (cdr (assoc -2 blk))) (while ent (entmod (subst (cons 8 "ELEC") (assoc 8 elst) elst)) (setq ent (entnext ent)) ) (command-s "_.attsync" "_name" (cdr (assoc 2 blk))) ) (princ) )

Dans le message original, tu disais : Donc, j'ai écris quelque chose en conséquence. Maintenant, tu dis : Pour changer le calque (entre autres) de toutes les entités des blocs d'un dessin, il y a Edit_Bloc sur cette page (penser à débloquer le ZIP avant d'extraire tout).

S'il n'y a qu'une définition de bloc à modifier, tu peux utiliser la commande GESTATTB (_BATTMAN) : dans la boite de dialogue, sélectionner l'attribut > Modifier... > onglet Options de texte > Rotation. Je ne comprends pas la question ("le layer du graphique d'un bloc"), mais là encore, c'est faisable sans LISP avec l'éditeur de bloc (commande MODIFBLOC ou _BEDIT).

Salut, Essaye ça: (defun c:manu_CAD (/ blk ent elst) (while (setq blk (tblnext "block" (not blk))) (setq ent (cdr (assoc -2 blk))) (while ent (if (= (cdr (assoc 0 (setq elst (entget ent)))) "ATTDEF") (entmod (subst (cons 8 "ELEC") (assoc 8 elst) elst) ) ) (setq ent (entnext ent)) ) (command-s "_.attsync" "_name" (cdr (assoc 2 blk))) ) (princ) )

Mais il n'y a ni InputBox ni InputBox2 dans la routine NBL ci-dessus !

De quoi parle-t-on ? Ce sujet a 15 ans et il n'y est jamais question d'une fonction INPUTBOX2 !

Salut, C'est le formatage du (plus très) nouveau CADxp qui avait bouffé une partie du code. J'ai corrigé le code de Hatch2Excel dans ma première réponse.

Salut, Essaye comme-ça : (defun c:N (/ nomBloc) ;; Insert une NOURRICE (setq nomBloc (if (tblsearch "block" "NOURRICE ECS-EFS") "NOURRICE ECS-EFS" "PL - NOURRICE ECS-EFS" ) ) (command "-inserer" nomBloc pause 1 1 "'osmode" 0 pause) (setvar "osmode" 15871) (princ) )

Si le logiciel relève bien du droit d'auteur, dans le cadre du salariat les droits patrimoniaux sont automatiquement cédés à l'employeur, seuls le droit au nom et le droit de divulgation sont conservés par le salarié (voir ici).

Non, si tu es salarié, tout ce que tu fais pendant tes heures de travail, que ce soit du dessin ou du code, appartient à ton patron, que tu l'aies partiellement ou totalement réalisé ne change rien. C'est la même chose pour un ouvrier ajusteur ou un mineur, la pièce qu'il a entièrement réalisée ou le charbon qu'il a extrait et qui n'existent que grâce à leur force de travail ne leur appartiennent pas. Donc soit tu codes en douce pour t'aider dans ton travail de dessinateur, soit tu lui fournis le code parce que tu "considères qu'il en a le "droit"" et de fait tu lui donnes le droit (sans guillemets) de te poursuivre si tu le refourgues à la concurrence. Dans les faits et suivant la teneur dudit code, il est probable qu'il ne le fasse pas. En ce qui concerne la protection du code source, avant de se poser la question du comment (compilation, obfuscation, langage, ...), il faut se demander si le code mérite vraiment d'être protégé au vu de tout ce qu'on peut trouver aujourd'hui en clair. De toutes façons, si un programme est intéressant au point que des hackers se penchent dessus, il finiront immanquablement par le craquer fusse-t-il compilé depuis du code C. PS: je n'officie pas sur Developpez.com, ce sont eux qui m'avaient sollicité pour reprendre les tutos publiés sur mon gileCAD.

je retombe par hasard sur ce vieux sujet et je constate que cette définition ne permet pas de passer des expressions à évaluer dans les "bindings". (let '((a (/ pi 3))) '(let '((sinus (sin a)) (cosinus (cos a))) '(list a sinus cosinus) ) ) renvoie : ((/ PI 3) (SIN A) (COS A)) C'est dû à l'utilisation de (apply ...) au lieu de (eval (cons ...)) (defun let (bindings body) (eval (cons '(list (mapcar 'car bindings) body) (mapcar 'cadr bindings) ) ) ) et maintenant, (let '((a (/ pi 3))) '(let '((sinus (sin a)) (cosinus (cos a))) '(list a sinus cosinus) ) ) renvoie : (1.0472 0.866025 0.5)

Le formatage du (nouveau) site a bouffé une partie du code. ;;; Pline_bloc -Gilles Chanteau- 04/09/06 ;;; Insère le bloc "pline_block" après sélection d'une polyligne ;;; Attribut 1 : Nom de la pièce ;;; Attribut 2 : Longueur de la polyligne ;;; Attribut 3 : Aire de la polyligne (defun c:pline_block (/ AcDoc Space bloc nom ent aire long ins) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (cond ((tblsearch "BLOCK" (setq bloc "Pline_block"))) ((findfile (setq bloc "Pline_block.dwg"))) (T (setq bloc nil)) ) (if bloc (progn (while (not (setq ent (car (entsel))))) (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") (progn (setq obj (vlax-ename->vla-object ent) id (vla-get-ObjectID obj) long (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).Length \\f \"%lu2\">%" ) aire (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).Area \\f \"%lu6%qf1\">%" ) ) (initget 1) (setq nom (getstring T "\nNom de la pièce: ")) (initget 1) (setq ins (trans (getpoint "\nPoint d'insertion: ") 1 0)) (setq ref (vla-InsertBlock Space (vlax-3d-point ins) bloc 1.0 1.0 1.0 0.0 ) ) (mapcar '(lambda (x y) (vla-put-TextString x y)) (vlax-invoke ref 'GetAttributes) (list nom long aire) ) (vla-regen AcDoc acActiveViewport) ) (alert "L'objet sélectionné n'est pas une polyligne.") ) ) (alert "Le bloc \"Pline_block\" est introuvable.") ) (princ) )

Quel LISP ? Il y a eu tellement de versions... Sans voir le code, je ne peux rien dire.

Ça ne s'arrange vraiment pas. Je ne vais pas tarder à me lasser de masquer tous ces messages...

Essaye ça: (defun c:ListBlock (/ ss name value block blocks insPt table row) (vl-load-com) (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))) ) (or *blocks* (setq *blocks* (vla-get-Blocks *acdoc*)) ) ;; Select blocks (prompt "\nSelect blocks to list or <All>") (or (setq ss (ssget '((0 . "INSERT")))) (setq ss (ssget "_X" '((0 . "INSERT"))) ) ) (if ss (progn ;; Build a list of dotted pairs (blockName . numberOfReferences) from the selection set (vlax-for x (setq ss (vla-get-ActiveSelectionSet *acdoc*)) (if (not (vlax-property-available-p x 'Path)) (setq name (cons (vla-get-EffectiveName x) (if (vl-some '(lambda (p) (and (vla-get-AllowedValues p) (= (type (setq value (vlax-get p 'Value))) 'STR) ) ) (vlax-invoke x 'GetDynamicBlockProperties) ) value "" ) ) blocks (if (setq block (assoc name blocks)) (subst (cons name (1+ (cdr block))) block blocks) (cons (cons name 1) blocks) ) ) ) ) (vla-delete ss) ;; Prompt for insertion point (initget 1) (setq insPt (trans (getpoint "\nInsertion point: ") 1 0)) ;; Create the table (setq table (vla-addtable (vla-get-modelspace *acdoc*) (vlax-3d-point insPt) (+ 2 (length blocks)) ; number of rows (including title and header) 4 ; number of colums 20 ; cell height 80 ; row width ) ) (vla-put-VertCellMargin table 4.0) (vla-put-TitleSuppressed table :vlax-false) (vla-put-HeaderSuppressed table :vlax-false) ;; Fill the titel and the header ;;(vla-setText table 0 0 "Blocks") ;;(vla-setText table 1 0 "Name") ;;(vla-setText table 1 1 "Count") ;;(vla-setText table 1 2 "Symbol") ;; Textes version Francaise (vla-setText table 0 0 "Quantitatif des Blocs") (vla-setText table 1 0 "Nom") (vla-setText table 1 1 "Nombre") (vla-setText table 1 2 "Visibilité") (vla-setText table 1 3 "Symbole") ;;;;; Hauteur des Textes dans la Table = 5.0 ;;;;; (vla-SetTextHeight table 7 5.0) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; fill the following rows from the list contents (setq row 2) (foreach item blocks (vla-settext table row 0 (caar item)) ; block name (vla-settext table row 1 (cdr item)) ; references count (vla-settext table row 2 (cdar item)) (vla-SetBlockTableRecordId ; block symbol table row 3 (vla-get-ObjectId (vla-Item *blocks* (caar item))) :vlax-true ) (setq row (1+ row)) ) ) ) (princ) )

C'est pourquoi je pense qu'il est préférable de ne chiffrer que les caractères alphabétiques (et éventuellement les chiffres).

Ou encore, bien mieux à mon avis, l'utilisation d'une fonction plus générique qui renvoie toutes les valeurs pour le code de groupe donné : ;; gc:massoc ;; Retourne la liste de toutes les valeurs pour le code spécifié dans une liste d'association ;; ;; Arguments ;; key : la clé à rechercher dans la liste ;; alst : une liste d'association (defun gc:massoc (key alst) (if (setq alst (member (assoc key alst) alst)) (cons (cdar alst) (gc:massoc key (cdr alst))) ) ) Pour obtenir le deuxième groupe 10 : (cadr (gc:massoc 10 (entget (entlast))))

Ou encore, s'il n'y a que deux groupes 10 : (assoc 10 (reverse (entget (entlast))))

Ou encore : (assoc 10 (cdr (member (assoc 10 (entget (entlast))) (entget (entlast)))))

Salut (assoc 10 (cdr (vl-member-if '(lambda (x) (= (car x) 10)) (entget (entlast)))))

Salut, 'Lineweight devrait fonctionner. Es-tu sûr de ne pas avoir fait une faute de frappe ?