Matt666

Oups !! I have forgotten that code !! Thank you I change it...

Un exemple d'utilisation du challenge !! ;;;xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ;;; Crée des copies Incrémentées du texte sélectionné (defun c:cpi ( / ent ntxt inc pt val lst ntxt) (setq cmdecho (getvar "cmdecho") m:err *error* *error* erreur ) (setvar "cmdecho" 0) (command "_undo" "D") (if (eq (ssget "i") nil) (setq ent (car (entsel "\nSélectionner texte à incrémenter :"))) (if (> (sslength (ssget "i")) 1) (setq ent (car (entsel "\nSélectionner texte à incrémenter :"))) (setq ent (ssname (ssget "i") 0)) ) ) (cond ((and ent (member (cdr (assoc 0 (entget ent))) '("TEXT" "MTEXT")) (setq inc (read2 (getstring "\nIncrément : "))) (setq pdst (getpoint (cdr (assoc 10 (entget ent)))"\nPoint d'insertion :")) ) (while pdst (if (or (eq pdst "I") (eq pdst "i")) (progn (while (not (setq inc (read2 (getstring "\nNouvel incrément : "))))) (setq pdst (getpoint (cdr (assoc 10 (entget ent)))"\nNouveau point d'insertion :")) ) ) (setq val (cdr (assoc 1 (entget ent)))) (if (and (eq (substr val 1 1) "0") (> (strlen val) 2) ) (setq lst (cons 0 (sep val))) (setq lst (sep val)) ) (cond ((and (eq 1 (length lst)) (or (eq (type (car lst)) 'REAL) (eq (type (car lst)) 'INT) ) ) (setq ntxt (+ inc (car lst))) (if (and (eq (substr val 1 1) "0") (< ntxt 10) (eq (type (car lst)) 'INT) (/= (substr (princ-to-string ntxt) 1 1) "0") ) (setq ntxt (strcat "0" (princ-to-string ntxt))) (setq ntxt (princ-to-string ntxt)) ) ) ((< 1 (length lst)) (setq ntxt "") (foreach pt lst (if (/= 0.00 pt) (if (or (eq (type pt) 'INT) (eq (type pt) 'REAL) ) (setq ntxt (strcat ntxt (princ-to-string (+ inc pt)) )) (setq ntxt (strcat ntxt pt)) ) (if (or (eq (type pt) 'INT) (eq (type pt) 'REAL) ) (setq ntxt (strcat ntxt "0")) ) ) ) ) ) (if ntxt (entmake (list (cons 0 (cdr (assoc 0 (entget ent)))) (cons 10 pdst) (cons 1 ntxt) (cons 8 (cdr (assoc 8 (entget ent)))) (cons 6 (cdr (assoc 6 (entget ent)))) (cons 62 (cdr (assoc 62 (entget ent)))) (cons 71 (cdr (assoc 71 (entget ent)))) (cons 72 (cdr (assoc 72 (entget ent)))) (cons 7 (cdr (assoc 7 (entget ent)))) (cons 40 (cdr (assoc 40 (entget ent)))) )) (princ "\nTexte créé.") ) (initget "I") (setq ent (entlast) pdst (getpoint (cdr (assoc 10 (entget ent)))"\nNouveau point d'insertion [incrément] :") ) ) ) ) (command "_undo" "F") (setq *error* m:err m:err nil) (setvar "cmdecho" cmdecho) (princ) ) Avec sep = routine de ElpanovEvgeniy ou de gile Et read2 c'est ça ;;; Read en prenant en compte le point (defun read2 (str) (if (/= str ".") (read str) str ) ) Voilà ! A bientot. matt EDIT : PS Faut pas oublier les VL avant princ-to-string, et tout le bazaar... J'ai pas testé sur autoCAD ! EDIT2 : Bout de code en trop déclé par ElpanovEvgeniy [Edité le 19/10/2007 par Matt666] [Edité le 19/10/2007 par Matt666]

Hello ElpanovEvgeniy ! Thank you for your quick answer ! The problem is we loose the first zero... if we have "0123", the program must return (0 123)... No ? A bientot.. Matt. ;)

C'est vrai que c'est impressionnant !! Bravo à vous tous pour ces routines, ya du boulot de compréhension :D par contre je crois qu'aucune de ces routines ne gère les chaînes de chiffres avec un 0 au début... Genre "0123"... Mais bon ce n'est pas trop compliqué, normalement !! A bientot ! Matt. PS : Et encore bravo, c'est vraiment très intéressant ces challenges..

J'ai l'impression qu'on ne peut pas toucher aux paramètres de présentation ni aux paramètres d'impression en autolisp... Est-ce le cas ??? C'est à dire sans commande... Merci ! A bientot. Matt.

Raaah c'est une bonne idée de décomposer la région pour la transformer en pline !! Je change les routines !! Merci Gile...

Essaie de sélectionner plusieurs polylignes, et qui ne se touchent pas forcément... Tu verras que ta routine s'arrête aux premières polylignes qui se touchent. Ma routine ne fonctionne pas tout à fait de la même façon... 1- Jeu de sélection de polylignes exclusivement 2- Utilise pline2points de Gile pour rechercher toutes les polylignes qui se touchent. S'il n'en trouve, il arrête la commande. 3- Transforme en région, unie et repasse en polyligne les entités qui passent cette étape. Voilà ! Parce que s'il ne trouve pas de polylignes qui se touchent, ils les changent quand même en région... Et ça c'est dommage. En plus il prend des polylignes par deux uniquement. Dans ma routine si 4 polylignes se touchent, il prend la polyligne qui a le plus de polyligne qui la touchent et unie celles-ci.. Voilà ! A+...

Exemple d'utilisation du code généré par ce challenge (bah oui faut bien quand même !) : Optimisation de polyligne : (defun c:OPL (/ CMDECHO CN DENT ENT LST N NLST SEL) (princ "\nSélectionner les polylignes à optimiser : ") (setq cmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (if (setq sel (ssget)) (progn (command "_UNDO" "D") (repeat (setq cn (sslength sel)) (setq ent (ssname sel (setq cn (1- cn))) dent (entget ent) lst (remove-doubles (remove-align (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) ) (foreach pt (remove-all lst (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))) (setq n (vl-position pt dent)) (setq nlst (append (sublist dent 0 n) (sublist dent (+ n 4) nil) ) ) (setq dent nlst) ) (entmod nlst) (entupd ent) (princ "\nPolyligne optimisée.") ) ) ) (command "_UNDO" "F") (setvar "cmdecho" cmdecho) (princ) ) ;;; SUBLIST De GILE (defun sublist (lst start leng / n r) (if (or (not leng) (< (- (length lst) start) leng) ) (setq leng (- (length lst) start)) ) (setq n (+ start leng)) (repeat leng (setq r (cons (nth (setq n (1- n)) lst) r)) ) ) ;;; REMOVE-ALIGN De GILE (defun remove-align (lst / rslt) (while (caddr lst) (if (betweenp (car lst) (caddr lst) (cadr lst)) (setq lst (cons (car lst) (cddr lst))) (setq rslt (cons (car lst) rslt) lst (cdr lst) ) ) ) (append (reverse rslt) lst) ) ;;; REMOVE-DOUBLES De GILE (defun remove-doubles (lst) (if lst (cons (car lst) (remove-doubles (vl-remove (car lst) lst))) ) ) ;;; REMOVE-ALL ;;; Supprime tous les éléments d'une liste à partir d'une autre ;;; (REMOVE-ALL '(1 3 5) '(1 2 3 4 5 6 7)) -> (2 4 6 7) (defun REMOVE-ALL (lise lisc) (foreach pt lise (setq lisc (vl-remove pt lisc))) ) ;;; BETWEENP Evalue si pt est entre p1 et p2 (ou égal à) ;;;Lisp de GILE (defun betweenp (p1 p2 pt) (or (equal p1 pt 1e-9) (equal p2 pt 1e-9) (equal (vec1 p1 pt) (vec1 pt p2) 1e-9) ) ) ;;; VEC1 Retourne le vecteur normé (1 unité) de p1 à p2 (nil si p1 = p2) ;;;Lisp de GILE (defun vec1 (p1 p2) (if (not (equal p1 p2 1e-009)) (mapcar '(lambda (x1 x2) (/ (- x2 x1) (distance p1 p2)) ) p1 p2 ) ) ) Voilà. Bon je sais mon code n'est pas des plus concis, et puis comme d'habitude, je n'ai pas du prendre en compte tous les cas de figures ! A bientot ! Matt. PS : Merci encore à vous pour ces très belles (je reste sur ma position de code "beau" bseb67 ;) ) routines qui nous font apprendre un peu plus ce langage ! [Edité le 15/10/2007 par Matt666]

Et est-ce que ce textPad idente les codes ?

Bon bah voilà, c'est fait !! Dis moi ce que tu en penses, moi je l'aime bien cette petite routine !! Elle utilise le pline2points de gile, pour pouvoir assurer la sélection d'objets dans une polyligne avec des arcs... Cette routine permet de fusionner deux polylignes fermées qui se touchent... Elle est assez pratique ! Biing ! (defun c:UNPL (/ lst lst2 cmdecho sel cn elts js sset sset2 entl ) (setq cmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (if (setq sel (ssget '((0 . "LWPOLYLINE")))) (progn (command "_UNDO" "D") (repeat (setq cn (sslength sel)) (setq lst (cons (ssname sel (setq cn (1- cn))) lst)) ) (while (< 1 (length lst)) (setq ELTS (cons (car lst) 0)) (foreach pt lst (if (and (setq JS (ssget "cp" (pline2points pt) '((0 . "LWPOLYLINE")))) (> (sslength (ssdel pt JS)) (cdr ELTS)) ) (setq ELTS (cons pt (sslength JS))) ) ) (if (> (cdr ELTS) 0) (progn (setq sset (ssadd)) (repeat (setq cn (sslength (setq JS (ssget "cp" (pline2points (car ELTS)) '((0 . "LWPOLYLINE")))))) (if (member (ssname JS (setq cn (1- cn))) lst) (ssadd (ssname JS CN) sset) ) ) (setq sset2 (ssadd) entl (entlast)) (command "_region" sset "") (while (setq entl (entnext entl)) (ssadd entl sset2) ) (command "_union" sset2 "") (setq ENT (entlast)) (command "_.explode" ent) (setq ss (ssget "_p") lst2 nil) (repeat (setq cn (sslength ss)) (setq lst2 (cons (ssname ss (setq cn (1- cn))) lst2)) ) (if (vl-every '(lambda (x) (member (cdr (assoc 0 (entget x))) '("LINE" "ARC"))) lst2) (command "_.pedit" (ssname ss 0) "_yes" "_join" ss "" "") ) ;(command "_erase" sset2 "") (redraw) (repeat (setq cn (sslength sset)) (setq lst (vl-remove (ssname sset (setq cn (1- cn))) lst)) ) ) (setq lst (vl-remove pt lst)) ) ) (command "_UNDO" "F") (princ "\nFusion réussie.") )) (setvar "cmdecho" cmdecho) (princ) ) ;; Pline2Points by Mister GILE en personne !!! ;; Retourne une liste de points (coordonnées SCU courant) situés sur une polyligne ;; Les polyarcs sont divisés en fonction de leur courbure. (defun Pline2Points (pline / bulge2arc elst elv norm dlst blst prec ang n plst) ;; bulge2arcdata ;; Retourne la liste des données d'un "polyarc" ;; (centre, rayon, angle de départ, angle total) (defun bulge2arcdata (bulg start end / ang cen rad) (setq ang (* 2 (atan bulg))) (setq rad (/ (distance start end) (* 2 (sin ang))) cen (polar start (+ (angle start end) (- (/ pi 2) ang) ) rad ) ) (list cen rad (angle cen start) (* ang 2)) ) (setq elst (entget pline) elv (cdr (assoc 38 elst)) norm (cdr (assoc 210 elst)) dlst (vl-remove-if-not '(lambda (x) (or (= (car x) 10) (= (car x) 42))) elst) ) (if (= 1 (logand 1 (cdr (assoc 70 elst)))) (setq dlst (append dlst (list (assoc 10 elst)))) ) (while (caddr dlst) (setq plst (cons (cdar dlst) plst)) (if (/= 0.0 (cdadr dlst)) (progn (setq blst (bulge2arcdata (cdadr dlst) (cdar dlst) (cdaddr dlst)) prec (1+ (fix (* 25 (sqrt (abs (cdadr dlst)))))) ang (/ (cadddr blst) prec) n 0 ) (repeat (1- prec) (setq plst (cons (polar (car blst) (if (minusp (cdadr dlst)) (+ pi (caddr blst) (* ang (setq n (1+ n)))) (+ (caddr blst) (* ang (setq n (1+ n)))) ) (cadr blst) ) plst ) ) ) ) ) (setq dlst (cddr dlst)) ) (mapcar '(lambda (x) (trans (list (car x) (cadr x) elv) norm 1) ) (reverse (cons (cdar dlst) plst)) ) ) UNPL = union polyligne... A bientot. Matt. EDIT : Suite aux lisps de GILE, changement du programme. [Edité le 17/10/2007 par Matt666]

Ta dernière routine s'avère assez complexe... Le fait de joindre deux polylignes qui se touchent et de supprimer le tronc commun est assez ardu ! Surtout lorsqu'on sélectionne plusieurs polyilgnes.. Mais ça devrait se faire... A beitnto ! Matt.

Ah oui ok c'est pas mal !! Petites corrections pour tes 2premiers lisp, si ça ne te dérange pas... (defun C:AR (/ sel ) (setq cmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (if (setq sel (ssget)) (progn (princ "\nSpécifier le point de contour : ") (command "_UNDO" "D" "_BOUNDARY" "O" "C" "N" sel "" "O" "P" "" pause "" "_CHANGE" (entlast) "" "PR" "_co" "bylayer" "" "_ERASE" sel "" ) (princ "\nContour créé.") ) (princ "\nAucune sélection.") ) (command "_UNDO" "F") (setvar "cmdecho" cmdecho) (princ) ) (defun C:RG2CT (/ ent) (setq cmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (if (ssget "i") (if (eq (sslength (ssget "i")) 1) (setq ent (ssname (ssget "i") 0))) (setq ent (car (entsel "\nSélectionner la région à convertir : "))) ) (cond ((and ent (eq "REGION" (cdr (assoc 0 (entget ent)))) ) (princ "\nSpécifier le point de contour : ") (command "_UNDO" "D" "_BOUNDARY" "O" "C" "N" ent "" "O" "P" "" pause "" "_CHANGE" (entlast) "" "PR" "_co" "bylayer" "" "_ERASE" ent "" ) (redraw) (princ "\nConversion effectuée.") ) ) (command "_UNDO" "F") (setvar "cmdecho" cmdecho) (princ) ) Ton 2ème lisp ne peut comporter qu'une seule entité dans la sélection...Il faut aussi vérifier que c'est bien une région. Pour le 3ème, je n'ai pas trop le temps de regarder, mais je verrai ça bientot ! A bientot, et bravo pour tes lisps :) EDIT : Suite à la demande de ingoenius, les entités sélectionnées au début sont intégrés à la routine. [Edité le 15/10/2007 par Matt666]

Ah pardon, désolé ! :) Normalement, c'est dans la boîte de dialogue... Je ne sais pas qi le paramètre de tolérance est disponible hors de la boite de dialogue... Je n'ai pas trouvé de variable à part peut être HALOGAP... voilà ! A bientot. Matt.

Ah zut !! Oui effectivement :mad2: Mais ça doit être cette routine qui m'a donné cette idée !! :P Bon bah je n'ai plus qu'à me taire maintenant... A bientot !! Matt.

Houlà c'est pas clair !!! Euh la liste est composée de quoi ? Si elle est composée d'enames (noms d'entités) : il faut créer un nouveau jeu de sélection, et le remplir avec un foreach (setq sset (ssadd)) (foreach pt (length lst) (ssadd pt sset) ) ou alors un mapcar (setq sset (ssadd)) (mapcar '(lambda (x) (ssadd x sset)) lst) A bientot. matt. [Edité le 12/10/2007 par Matt666]

Ok d'ac !! Merci vous ! BonusCAd, c'est bien ce que je me disais... on ne peut pas accéder à une entlast puisqu'aucune entité n'est encore créée... Bred, à la base je voulais refaire l'une des routines de Gile qui permet de donner la longueur de la polyligne au fur et à mesure qu'on la créé en AUTOLISP... c'est à dire sans vl-cmdf... Pour pouvoir récupérer le type de segment créé (arc ou ligne) je pensais pouvoir récupérer les types d'entités avoir un entlast bien placé... Mais bon ça risque d'être plus compliqué... J'ai peur qu'on ne puisse pas faire ça en suivant la commande _pline... Reste plus qu'à faire une routine qui créé un polyligne par un entmake, ce sera plus simple ! Merci à vous ! A bientot. Matt.

je travaille dessus depuis 2 ans à peu près... Au fait c'est BricsCAD ! :) bah après avoir testé plusieurs clones d'autoCAD, notamment les moteurs intelliCAD (intelliplus, BricsCAD, intelliDesk) et aussi geodès, le logiciel de DAo de mensura ; On s'est très vite aperçu que BricsCAD sortait du lot. Au début Intelliplus était plus avancé, mais BricsCAD a très (TRES !) rapidement dépassé son concurrent... C'est, à notre avis (la boite dans laquelle je travaille) le meilleur clone d'AutoCAD. la différence de Autocad LT, c'est que BricsCAD intègre les outils de programmation LISP et VBA. par contre pour l'instant c'est juste de l'autoLISP. La version 8 béta est sortie très (trop...) récemment en proposant une revisite complète du fenétré, en essayant d'intégrer de nouveaux outils. Pour l'instant elle ne tourne pas bien, ya beaucoup de bugs. mais elle a l'air assez prometteuse. notamment, pour les mordus de LISP, une adaptation VLISP (ALLLELLIUUUUAAAAA !!!!) Voilà. Si tu veux plus d'infos, ya évidemment un site... A bientot !! matt.

Alors essaie cette petite chose, dans ce cas.... ;;; 1 - Ajout de sommets en sélectionnant une polyligne (defun c:APL (/ CMDECHO ENT ENTL SSET) (setq cmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (cond ((and (setq ent (entsel "\nSélectionner la polyligne : ")) (member (cdr (assoc 0 (entget (car ent)))) '("POLYLINE" "LWPOLYLINE")) ) (setq entl (entlast) sset (ssadd)) (command "_BREAK" (cadr ent) (cadr ent)) (while (setq entl (entnext entl))(ssadd entl sset)) (command "pedit" (car ent) "J" (ssname sset 0) "" "") ) ) (setvar "cmdecho" cmdecho) (princ) ) ;;;2- Ajout d'un sommet en sélectionnant un point sur une polyligne sans la sélectionner (defun c:APL (/ OSMODE CMDECHO PT SEL ENTL SSET) (setq osmode (getvar "osmode") cmdecho (getvar "cmdecho")) (setvar "osmode" 515) (setvar "cmdecho" 0) (cond ((and (setq pt (getpoint "\npointer sur le point de la polyligne à ajouter : ")) (setq sel (ssget pt)) (member (cdr (assoc 0 (entget (ssname sel 0)))) '("POLYLINE" "LWPOLYLINE")) ) (setq entl (entlast) sset (ssadd)) (command "_BREAK" pt pt) (while (setq entl (entnext entl))(ssadd entl sset)) (command "pedit" (ssname sel 0) "J" (ssname sset 0) "" "") ) ) (setvar "osmode" osmode) (setvar "cmdecho" cmdecho) (princ) ) Dis moi ce que tu en penses !! Si tu n'arrives pas à comprendre dis moi et je t'expliquerai. EDIT : Ajout d'une routine qui sélectionne la polyligne en sélectionnant un point de celle-ci... [Edité le 12/10/2007 par Matt666]

le pb c'est qu'il faut savoir entre quel sommets il faut ajouter le sommet. Soit tu sélectionnes les deux sommets entre lesquels le nouveau sommet sera ajouté Soit tu trouves les deux sommets les plus proches.

Ah tiens c'est marrant comme routine ça... et puis ça démontre bien la puissance du VLISP.. Bravo :

Regarde ce petit post très bien fait, tu comprendras mieux les principes de l'extraction des données d'attribut ! ;) A bientot. Matt.

Vive les fautes d'orthographe et la compréhension !! ;) Si je comprends bien tu veux un outil qui permette de créer un contour ou une région à partir d'une sélection d'objets, et en plus qui ne se croisent pas forcément ???? C'est chaud ça !!! Voire même pas trop possible ! Enfin d'après mes maigres connaissances en DAO... A la limite, si tu changes la tolérance de contour dans la boîte de dialogue _boundary, tu peux créer un contour fermé à partir de zones plus ou moins ouvertes.. une méthode de contour par sélection d'objets n'est pas forcément évidente... On peut trouver un paquet de contours fermés avec une sélection d'objets... C'est pour ça que la pointage à l'intérieur d'une zone fermée semble la méthode la plus intéressante. Enfin bon, je me plante surement, mais c'est pas trop faisable de faire ça... Pas en deux clics en tout cas :cool: voilà... A bientot. Matt.

Tu n'as plus qu'à mettre la discussion en résolu ! A bientot.. Matt.

Et tu es sur de ta variable MIRRTEXT, aussi ? Chez moi ça fonctionne très bien, et pas de cases cochées !

Attends tes outils ne sont pas les mêmes pour les utilisateurs ? Dans ce cas ça se complique... Non tu ne le fais qu'une seule fois. Ensuite c'est enregistré dans le registre. Les barres d'outills sont des fichiers BMP et un fichier MNU+fichier MNL. Ces fichiers sont copiés dans un répertoire spécifique du serveur. Et tous les PC viennent pointer sur ce répertoire du serveur où sont stockés tous tes fichiers liés à tes outils... Tu vois ? En fin de compte il 'y a rien d'autre que les fichiers du logiciel DAo en local, et tous tes outils sont sur le serveur ! Je ne sais pas si je suis clair... Désolé ! Regarde ce post si tu veux ajouter en auto ton chemin lié à tes outils sur le serveur... Voilà ! En espérant avoir été plus clair...