(gile)

Denis, tu confonds, l'expression pour récupérer les coordonnées d'une polyligne "optimisée" est celle donnée dans le premier message de ce fil.

Pour Phil, Tu t'imagines bien que j'ai pensé à toutes les utilisations possibles de ces LISP que j'ai fait récemment. Ce dont je voudrait être sûr, c'est que le texte est bien à l'intérieur de la région (si la région contient bien un texte, ce qui n'est pas, non plus, obligatoire). J'aurais bien des idées, à partir de la bounbing box de la région, mais ce n'est pas suffisament rigoureux à mon goût. Pour lecrabe, En l'état la routine ne force pas la valeur de DELOBJ, je pensais laisser le choix à l'utilisateur. [Edité le 15/10/2006 par (gile)]

C'est dans l'autre sens, que le contrôle doit se faire : est-ce que le texte est bien à l'intérieur de la région ? C'est comme ça que fonctionne SelPline, le fait que la ligne croise 2 fois la région ne prouverait rien, la région peut avoir une forme "biscornue" et/ou des ilots faits par soustraction.

Salut, Les polylignes "anciennes" et les polylignes "optimisées" n'ont pas leurs sommets stockées de la même manière. Les premières, dans des sous entités accessibles avec (entnext ...), les secondes dans les gorupes DXF 10 de la liste DXF de l'entité. Pour les sommets d'une polyligne optimisée revois cet ancien sujet que tu avais réveilléici.

Première amélioration : le choix des calques se fait par une petite boite dialogue (version 1.1). [Edité le 15/10/2006 par (gile)]

Salut, Un petit truc vite fait (encore avec SelByObj), sûrement à améliorer (pas encore de traitement des régions). Version 1.2 Supprimer les espaces entre les ;;; TEXTRUDE Extrude les objets (cercle, ellipse, lwpolyligne) du calque spécifié ;;; de la hauteur donnée dans le texte contenu dans chaque objet. (defun textrude_err (msg) (if (= msg "Fonction annulée") (princ) (princ (strcat "\nErreur: " msg)) ) (command "_.undo" "_end") (setvar "CMDECHO" echo) (setq *error* m:err m:err nil ) (princ) ) (defun c:textrude (/ textrude_err laytxt layobj ssobj echo sstxt alt) (setq m:err *error* *error* textrude_err echo (getvar "CMDECHO") ) (if (and (setq laytxt (getlayer "Calque des textes de hauteur d'extrusion") ) (setq layobj (getlayer "Calque des objets à extruder")) ) (progn (setq ssobj (ssget "_X" (list '(-4 . "[color=#CC0000] '(-4 . "[color=#CC0000] '(0 . "CIRCLE") '(0 . "ELLIPSE") '(-4 . "[color=#CC0000] '(0 . "LWPOLYLINE") '(-4 . "&") '(70 . 1) '(-4 . "AND>") '(-4 . "OR>") (cons 8 layobj) '(-4 . "AND>") ) ) ) (command "_.undo" "_begin") (setvar "CMDECHO" 0) (if ssobj (foreach e (mapcar 'cadr (ssnamex ssobj)) (if (and (setq sstxt (SelByObj e "WP" (list '(0 . "*TEXT") (cons 8 laytxt)) ) ) (numberp (setq alt (read (cdr (assoc 1 (entget (ssname sstxt 0))))) ) ) ) (if ( (command "_.extrude" e "" alt) (command "_.extrude" e "" alt 0.0) ) ) ) ) (command "_.undo" "_end") (setvar "CMDECHO" echo) ) ) (setq *error* m:err m:err nil ) (princ) ) SelByObj ;;; SelByObj -Gilles Chanteau- 06/10/06 ;;; Crée un jeu de sélection avec tous les objets contenus ou ;;; capturés, dans la vue courante, par l'objet sélectionné ;;; (cercle, ellipse, polyligne fermée). ;;; Arguments : ;;; - un nom d'entité (ename) ;;; - un mode de sélection (Cp ou Wp) ;;; - un filtre de sélection ou nil (defun SelByObj (ent opt fltr / obj dist n lst prec dist p_lst) (vl-load-com) (if (= (type ent) 'ENAME) (setq obj (vlax-ename->vla-object ent)) ) (cond ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE")) (setq dist (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) 50 ) n 0 ) (repeat 50 (setq lst (cons (trans (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n)))) 0 1 ) lst ) ) ) ) (T (setq p_lst (vl-remove-if-not '(lambda (x) (or (= (car x) 10) (= (car x) 42) ) ) (entget ent) ) ) (while p_lst (setq lst (append lst (list (trans (append (cdr (assoc 10 p_lst)) (list (cdr (assoc 38 (entget ent)))) ) ent 1 ) ) ) ) (if (/= 0 (cdadr p_lst)) (progn (setq prec (1+ (fix (* 50 (abs (cdadr p_lst))))) dist (/ (- (if (cdaddr p_lst) (vlax-curve-getDistAtPoint obj (trans (cdaddr p_lst) ent 0) ) (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) ) prec ) n 0 ) (repeat (1- prec) (setq lst (append lst (list (trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) (* dist (setq n (1+ n))) ) ) 0 1 ) ) ) ) ) ) ) (setq p_lst (cddr p_lst)) ) ) ) (ssget (strcat "_" opt) lst fltr) ) GETLAYER boite dialogue pour la sélection d'un calque. Fichier DCL à enregistrer sous : getlayer.dcl dans un dossier du chemin de recherche des fichiers de support. getlayer:dialog{ label="Choisir un calque"; initial_focus="lay"; :boxed_column{ :text{ is_bold=true; key="titre"; } spacer; :row{ :column{ :text{ label="Sélectionner un objet"; alignment=left; } } :column{ :button{ label=">>"; key="obj"; alignment=right; fixed_width=true; } spacer; } } :edit_box{ key="tp"; edit_width=25; } :popup_list{ key="lay"; edit_width=25; } spacer; } ok_cancel; } GetLayer, le LISP : ;;; GetLayer Retourne le nom du calque entré ou choisi par l'utilisateur ;;; dans une liste déroulante de la boite de dialogue ou en sélectionnant ;;; un objet à l'écran. ;;; Argument : un titre (string) (defun getlayer (titre / lay lst what_next dcl_id nom) (setq lay (tblnext "LAYER" T)) (while lay (setq lst (cons (cdr (assoc 2 lay)) lst) lay (tblnext "LAYER") ) ) (setq lst (acad_strlsort lst)) (setq dcl_id (load_dialog "GetLayer.dcl")) (setq what_next 2) (while (>= what_next 2) (if (not (new_dialog "getlayer" dcl_id)) (exit) ) (start_list "lay") (mapcar 'add_list lst) (end_list) (set_tile "titre" titre) (action_tile "obj" "(done_dialog 3)") (action_tile "tp" "(setq nom (get_tile \"tp\")) (done_dialog 4)" ) (action_tile "accept" (strcat "(progn" "(setq nom (nth (atoi (get_tile \"lay\")) lst)))" "(done_dialog 1))" ) ) (setq what_next (start_dialog)) (cond ((= what_next 3) (if (setq nom (car (entsel))) (setq nom (cdr (assoc 8 (entget nom))) what_next 1) (setq what_next 2) ) ) ((= what_next 4) (cond ((tblsearch "LAYER" nom) (setq what_next 1) ) (T (alert (strcat "Le calque \"" nom "\" est introuvable.")) (set_tile "tp" "") (setq what_next 2) ) ) ) ((= what_next 0) (setq nom nil) ) ) ) (unload_dialog dcl_id) nom ) [Edité le 15/10/2006 par (gile)][Edité le 16/10/2006 par (gile)] [Edité le 16/10/2006 par (gile)]

La commande existe toute faite dans AutoCAD, elle s'appelle ai_molc. C'est un LISP, tu peux le trouver dans le fichier AutoCAD.mnl. http://img116.imageshack.us/img116/9136/aimolcqu7.png Pour les accrchages, c'est bien la variable système OSMODE, et c'est bien la somme des codes binaires.

Salut, Pour l'aire et le périmètre, si tu veux utiliser des champs dynamiques, vois ce sujet.

Salut, Il faut taper break_lw à la ligne de commande. En LISP, les fonctions qui définissent une commande commencent par (defun c:NomDeLaCommande ...) Je dirais que le LISP est de Bonuscad, il fonctionne très bien.

Salut Oli, J'avais fait un petit LISP pour renommer un bloc, moins puissant que celui de Patrick_35 (pas de réacteur), mais qui accepte la pré-selection du bloc et peut donc être glissé dans le menu contextuel des "objets de référence de bloc".

si tu veux comprendre de nouvelles fonctions LISP, fait des tests avec la console de l'éditeur VisualLISP ou directement à la ligne de commande. Si tu as des difficultés avec l'anglais, les fonctions LISP sont décrites en français sur aidacad. C'est au moins la troisième fois que je te donne ce lien !!! Je risque de finir par me lasser.

Personnellement, je mettrais plutôt un paramètre de visibilté.

Une autre version, qui compte toutes les réferences insérées pour chaque référence sélectionnée. Les xrefs sont écartées (je modifie la version précédente pour écarter aussi les xrefs). (defun c:tabloblo (/ libloc liidbloc ss col liref ptins tableVL cont) (vl-load-com) (prompt "\nSélectionnez les blocs à lister ou < Tous >") (if (not (setq ss (ssget '((0 . "INSERT"))))) (setq ss (ssget "_X" '((0 . "INSERT"))) col T ) ) (if ss (setq liref (mapcar '(lambda (x) (setq x (vlax-ename->vla-object x)) (if (vlax-property-available-p x 'EffectiveName) (vla-get-EffectiveName x) (vla-get-Name x) ) ) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ) ) (setq liref '()) ) (if col (vlax-for i (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object)) ) (if (and (/= (substr (vla-get-name i) 1 1) "*") (= :vlax-false (vla-get-IsXref i)) ) (setq libloc (append libloc (list (vla-get-name i))) liidbloc (append liidbloc (list (vla-get-ObjectID i))) ) ) ) (setq libloc (remove_doubles liref) liidbloc (mapcar '(lambda (x) (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object) ) ) x ) ) ) libloc ) ) ) (initget 1) (setq ptins (trans (getpoint "\nPoint d'insertion: ") 1 0)) (setq tableVL (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)) ) (vlax-3d-point ptins) (length libloc) 3 20 100 ) ) (vla-put-TitleSuppressed tableVL :vlax-true) (setq cont -1) (repeat (vla-get-Rows tableVL) (vla-settext tableVL (setq cont (1+ cont)) 0 (nth cont libloc) ) (vla-settext tableVL cont 1 (length (vl-remove-if-not '(lambda (n) (= n (nth cont libloc))) liref ) ) ) (vla-SetBlockTableRecordId tableVL cont 2 (nth cont liidbloc) :vlax-true ) (vla-setcellalignment tableVL cont 0 5) (vla-setcellalignment tableVL cont 1 5) ) (princ) ) ;;; REMOVE_DOUBLES - Suprime tous les doublons d'une liste (defun REMOVE_DOUBLES (lst) (cond ((atom lst) lst) (T (cons (car lst) (REMOVE_DOUBLES (vl-remove (car lst) lst))) ) ) ) [Edité le 17/10/2006 par (gile)]

La bouteille à Tramber et les fleurs à madame Tramber, je ne fais qu'adapter (et apprendre). Voici un premier jet avec possibilité de faire une sélection ou de lister toute la collection en faisant ENTER ou clic droit. En l'état, seuls sont comptés les blocs sélectionnés. Si tu veux que soient comptés tous les blocs insérés dont un exemplaire a été sélectionné, c'est un peu plus compliqué à cause des blocs dynamiques qui changent de nom quand ils ont été modifiés, mais faisable. Tiens moi/nous au courant. (defun c:tabloblo (/ libloc liidbloc sst ssu liref ptins tableVL cont) (prompt "\nSélectionnez les blocs à lister ou < Tous >") (setq ssu (ssget '((0 . "INSERT")))) (setq sst (ssget "_X" '((0 . "INSERT")))) (if sst (setq liref (mapcar '(lambda (x) (setq x (vlax-ename->vla-object x)) (if (vlax-property-available-p x 'EffectiveName) (vla-get-EffectiveName x) (vla-get-Name x) ) ) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sst))) ) ) (setq liref '()) ) (if ssu (setq libloc (remove_doubles (mapcar '(lambda (x) (setq x (vlax-ename->vla-object x)) (if (vlax-property-available-p x 'EffectiveName) (vla-get-EffectiveName x) (vla-get-Name x) ) ) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssu))) ) ) liidbloc (mapcar '(lambda (x) (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object) ) ) x ) ) ) libloc ) liref (vl-remove-if-not '(lambda (n) (member n libloc)) liref) ) (vlax-for i (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object)) ) (if (and (/= (substr (vla-get-name i) 1 1) "*") (= :vlax-false (vla-get-IsXref i)) ) (setq libloc (append libloc (list (vla-get-name i))) liidbloc (append liidbloc (list (vla-get-ObjectID i))) ) ) ) ) (setq ptins (getpoint "\nPoint d'insertion: ")) (vl-load-com) (setq tableVL (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)) ) (vlax-3d-point ptins) (length libloc) 3 20 100 ) ) (vla-put-TitleSuppressed tableVL :vlax-true) (setq cont -1) (repeat (vla-get-Rows tableVL) (vla-settext tableVL (setq cont (1+ cont)) 0 (nth cont libloc) ) (vla-settext tableVL cont 1 (length (vl-remove-if-not '(lambda (n) (= n (nth cont libloc))) liref ) ) ) (vla-SetBlockTableRecordId tableVL cont 2 (nth cont liidbloc) :vlax-true ) (vla-setcellalignment tableVL cont 0 5) (vla-setcellalignment tableVL cont 1 5) ) (princ) ) ;;; REMOVE_DOUBLES - Suprime tous les doublons d'une liste (defun REMOVE_DOUBLES (lst) (cond ((atom lst) lst) (T (cons (car lst) (REMOVE_DOUBLES (vl-remove (car lst) lst))) ) ) ) [Edité le 13/10/2006 par (gile)]

Suite à la suggestion de Tramber, le même avec des colonnes un peu plus étroites et une troisième colonne pour le nombre de blocs insérés. (defun c:tabloblo (/ libloc liidbloc ss liref ptins tableVL cont) (vl-load-com) (vlax-for i (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object)) ) (if (/= (substr (vla-get-name i) 1 1) "*") (setq libloc (append libloc (list (vla-get-name i))) liidbloc (append liidbloc (list (vla-get-ObjectID i))) ) ) ) (setq ss (ssget "_X" '((0 . "INSERT")))) (if ss (setq liref (mapcar '(lambda (x) (setq x (vlax-ename->vla-object x)) (if (vlax-property-available-p x 'EffectiveName) (vla-get-EffectiveName x) (vla-get-Name x) ) ) (mapcar 'cadr (ssnamex ss)) ) ) (setq liref '()) ) (initget 1) (setq ptins (trans (getpoint "\nPoint d'insertion: ") 1 0)) (setq tableVL (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)) ) (vlax-3d-point ptins) (length libloc) 3 20 100 ) ) (vla-put-TitleSuppressed tableVL :vlax-true) (setq cont -1) (repeat (vla-get-Rows tableVL) (vla-settext tableVL (setq cont (1+ cont)) 0 (nth cont libloc) ) (vla-settext tableVL cont 1 (length (vl-remove-if-not '(lambda (n) (= n (nth cont libloc))) liref ) ) ) (vla-SetBlockTableRecordId tableVL cont 2 (nth cont liidbloc) :vlax-true ) (vla-setcellalignment tableVL cont 0 5) (vla-setcellalignment tableVL cont 1 5) ) (princ) ) [Edité le 17/10/2006 par (gile)]

Je réponds à ma propre remarque : Il suffit d'ajouter (vla-put-TitleSuppressed tableVL :vlax-true) après le (setq tableVL (vla-addtable ...))

Il est bien ton LISP, Tramber :) Juste un truc, si le style de tableau courant contient une rangée "Titre", le nom du premier bloc de la collection s'y affiche, sans le bloc bien sûr. Il suffit de le savoir.

Un exemple en image. Épure d'un cône oblique, projections et développé (dessin 2D). http://img189.imageshack.us/img189/8708/conemt1.png Le même cône modélisé affiché sous différentes vues (solide 3D). http://img176.imageshack.us/img176/9894/cone2uh5.png

Je crains de ne pas comprendre ta demande. Je sais ce qu'est le "trait de charpente", je suis menuisier, et pratique aussi le "trait" ainsi que la géométrie descriptive qui en est issue. Leur objet est la représentation et l'étude des figures en 3 dimensions (surfaces, solides) en les ramenant à des problèmes de géométrie plane par le traçage sur la feuille de papier (ou le plancher à épure), donc en 2 dimensions. Au vue de ta première question et de ta réponse, je n'arrive pas à déterminer si tu travailles en 2D (projections de différentes vues et rabattements comme une épure de géométrie descriptive) ou en 3D (surface ou solide 3D pouvant être affiché suivant différents points de vue). [Edité le 12/10/2006 par (gile)]

Voir aussi ce sujet.

Salut, Les expressions : (if ( Peut-être as tu oublié un setq ?

Salut, L'expression (setq style (tblnext "style")) n'est pas à l'intérieur de la boucle (de plus il y a une paranthèse fermante de trop). Utilise l'éditeur VisualLISP, un double-clic devant une paranthèse ouvrante ou derrière une paranthèse fermante et toute l'expression est sélectionnée. http://img192.imageshack.us/img192/5711/styledz6.png

Salut, tu peux mettre dans ton script l'expression LISP : (load "C:/Temp/lisp/sel_obj.lsp")

On peut en effet ajouter au fichier AutoCAD.pgp : IE, START IEXPLORE http://www.cadxp.com, 1, , et après avoir rechargé le fichier (taper reinit > cocher "Fichier PGP" > OK ou re-init >> 16) il suffit de taper IE.

Salut kallain, pour avoir une polyligne à la place d'une ligne pour le raccordement, dans Rac_ob, remplace : (entmake (list '(0 . "LINE") (cons 10 (trans cen ucszdir 0)) (cons 11 (vlax-curve-getClosestPointTo (vlax-ename->vla-object n) (trans cen ucszdir 0) ) ) ) ) par : (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 2) '(70 . 0) (cons 38 elev) (cons 210 ucszdir) (cons 10 cen) (cons 10 (trans (vlax-curve-getClosestPointTo (vlax-ename->vla-object n) (trans cen ucszdir 0) ) 0 ucszdir ) ) ) )