Fraid

Bonjour, Peut etre peut tu cacher le calque dans un éditeur de pdf? Avec Acrobat pro j'y arrive, mais il doit en avoir d'autre qui le permet.

Bonjour, Chacun vois les challenges comme ils veulent. C'est pour moi une occasion de programmer en m'amusant. je ne cherche pas la performance, juste atteindre un but. La, je n'avais pas beaucoup de temps non plus, et pas envie de tripoter des listes de points. je suis donc partis avec l'algorithme Fraidskull (voir Strange n°666) Je ne pense pas qu'il serve un jour de référence....hihihi Sinon, Didier, je pense que tu peux évité de demander permission d'utilisé du code qui est déjà partagé. Si on diffuse, c'est pour cela, n'est ce pas? Sinon, bravo à tous, pour ces exemples de concisions.

Bonjour, Je me permet de poster mais c'est tellement brut, que cela répond au challenge que part son résultat. pas son algorithme "Viking" (defun Quickhull (lpt / acdc mods oldosmode oldcmdecho lptmp ptrec zone sel ob ct) (vla-zoomextents (vlax-get-acad-object)) (setq acdc (vla-get-activedocument (vlax-get-acad-object)) mods (vla-get-modelspace acdc) oldosmode (getvar 'osmode) oldcmdecho (getvar 'cmdecho) zone (coordaffichage) lptmp (cdr lpt) ) (setvar 'osmode 0) (setvar 'cmdecho 0) (foreach pt1 lpt (foreach pt2 lptmp (vla-AddLine mods (vlax-3d-point (car pt1)(cadr pt1) 0) (vlax-3d-point (car pt2)(cadr pt2) 0)) ) (setq lptmp (cdr lptmp)) ) (setq ptrec (vlax-make-safearray vlax-vbDouble '(0 . 14))) (vlax-safearray-fill ptrec (list (1-(caar zone)) (1-(cadar zone)) 0 (1-(caar zone)) (1+(cadadr zone)) 0 (1+(caadr zone)) (1+(cadadr zone)) 0 (1+(caadr zone)) (1-(cadar zone)) 0 (1-(caar zone)) (1-(cadar zone)) 0 ) ) (vla-AddPolyline mods ptrec) (vla-zoomextents (vlax-get-acad-object)) (vla-regen acdc acActiveViewport) (vl-cmdf "_.-boundary" (car zone) "") (setq sel (ssget "_x" (list (cons 0 "*POLYLINE"))) ct -1) (while (setq ob (ssname sel (setq ct (1+ ct)))) (if (/= ct 1)(vla-delete (vlax-ename->vla-object ob))) ) (setq sel (ssget "_x" (list (cons 0 "LINE"))) ct -1) (while (setq ob (ssname sel (setq ct (1+ ct)))) (vla-delete (vlax-ename->vla-object ob)) ) (setvar 'osmode oldosmode) (setvar 'cmdecho oldcmdecho) (princ) ) (defun coordaffichage ( / viewctr viewsize screensize) (mapcar 'set '(viewctr viewsize screensize) (mapcar 'getvar '(viewctr viewsize screensize))) ((lambda (dimxy) (list (mapcar '- viewctr dimxy) (mapcar '+ viewctr dimxy))) (list (* viewsize (/ (car screensize) (cadr screensize) 2.)) (/ viewsize 2) 0.0) ) ) et un test un peux différent, puisque je dessine la polyligne (defun c:test (/ ss i pts) (if (setq ss (ssget '((0 . "point")))) (progn (repeat (setq i (sslength ss)) (setq pts (cons (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) pts ) ) ) (quickhull pts) ) ) (princ) )

un fichier par niveaux + un fichier maître qui les regroupe en xref et qui contient la présentation, facilite la vie de tout le monde. Mais chaque bureau à son organisation, il n'y as pas de régles...

Vu de loin, ça à l'air d'une usine à gaz vos plans ... vous dessiner vos niveaux dans le même dwg et superposé?

T'inquiète, c'est juste pour éviter de dessiner une volée cela ne résous en rien le challenge

Bonjour, En attendant, un p'tit lispounet pour dessiner des points dans une zone de manière pseudo-aléatoire (defun add-random-pts (nb zon / acdc cpt nbc) (setq acdc (vla-get-activedocument (vlax-get-acad-object)) cpt -1 nbc (strlen (itoa (1- (caadr zon))))) (while (< (setq cpt (1+ cpt)) nb) (vla-AddPoint (vla-get-modelspace acdc) (vlax-3d-point (+(random nbc nil)(caar zon)) (+ (random nbc nil)(cadar zon)) 0)) ) ) ;Random ;Retourne un Entier pseudo-aléatoire ;(random arg1 arg2) ;Arg1 : Entier nombre de chiffres maxi. ex 2 -> 1 à 99, 5 -> 1 à 99999 ;Arg2 : T ou nil si T 2 -> 10 à 99, 5 -> 10000 à 99999 ;Retour : Entier (defun Random (n m / rd) (if (null *RDM*)(setq *RDM* (getvar 'date))) (setq rd (fix (* (/ (setq *RDM* (rem (+ 1013904223.0 (* 1664525.0 *RDM*)) 4294967296.0 ) ) 4294967296.0 ) (expt 10.0 n) ) ) ) (if (and m (< rd (expt 10 (1- n)))) (setq rd (+ rd (expt 10 (1- n))));Maintient ) rd ) ;pour 50 points dans une zone 0,0 100,100 (add-random-pts 50 '((0 0)(100 100)))

je suis désolé, mais avec ce lisp pour extraire des profils d'un nuage, j’atteins les limites de partage... déjà parce que ce n'est qu'une expérimentation encore en cours et que cela répond à un cahiers des charges bien précis qui ferais gagner trop d'argent à des gent comme Vinchi, ou bouigche pour pas les citer...

non non, j'extrait les points 3d que je projette à plat ensuite

Bonjour, Si il y a un argument en plus qui est la "résolution" (longueur max des faces du polygone) je sais faire. Mais sans, je ne vois pas comment déterminer si on doit rejoindre ou non un point...surtout si on a une volée en forme de croissant. Notamment avec l'algorithme que tu nous présente au début du message. Avant que tu poste ce challenge, je commençais à reprendre mon lisp qui me donne un profil dans un nuage de points. (l'outil Autocad est vraiment inutile...) en essayant d'intégrer l'algo que tu avais posté sur theswamp. du coup, il me semble que c'est la solution non?

et puis si tu travail avec des gabarits bien encalqué c'est inutile.

Bonjour, il me semble, comme je te l'ai dit précédemment, que getfiled en autolisp, me semble convenir a ta demande. Après, pour importer des calques, il existe un outil déjà intégré à Autocad qui s’appelle le gestionnaire d'état de calques tu enregistre un état, tu obtient un .lay que tu importe avec le même outil

Bonjour Il est peut être plus judicieux de passer par un objet Shell qu'excel qui n'est pas forcément installé il y a plein d'exemple sur le net, Denis je me permet de te rappeler l’existence de Google...tape explorer un dossier en VBA sinon en passant, en Autolisp c'est getfiled

Bonjour, Je te propose un lisp qui traite les dwg sans les ouvrir. ;;;attbyblock ;;;Met la couleur des attributs en argument en couleur "DuBloc" ;;;Arg: nom, String Nom du bloc ;;; latt, Liste des atrributs (étiquettes) ;;; acdc; (vla-get-activedocument (vlax-get-acad-object))) ou axdbdoc (defun attbyblock (nom latt acdc / color ret) (setq color (vlax-create-object (strcat "AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2)))) (vla-put-colorIndex color AcByBlock) (vlax-for bl (vla-get-modelspace acdc) (if (and (= (vla-get-ObjectName bl) "AcDbBlockReference")(= (vla-get-EffectiveName bl) nom)) (progn (foreach at (vlax-invoke bl 'GetAttributes) (if (member (vla-get-tagstring at) latt) (vla-put-TrueColor at color) ) ) (setq ret T) ) ) ) ret ) ;Accèder à un dessin fermé (defun getaxdbdoc (filename / axdbdoc release) (setq axdbdoc (vlax-create-object (if (< (setq release (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument" (strcat "ObjectDBX.AxDbDocument." (itoa release)) ) ) ) (if (vl-catch-all-apply 'vla-open (list axdbdoc filename)) (not (vlax-release-object axdbdoc)) axdbdoc ) ) ;Sélection d'un dossier (defun getdir( / shell rep) (setq shell (vlax-create-object "Shell.Application") rep (vlax-invoke shell 'browseforfolder 0 "Sélectionnez le dossier" 512 "") ) (vlax-release-object shell) (strcat (vlax-get-property (vlax-get-property rep 'self) 'path) "\\") ) ;String en liste (defun str2lst (str sep / pos) (if (setq pos (vl-string-search sep str)) (cons (substr str 1 pos) (imp-str2lst (substr str (+ (strlen sep) pos 1)) sep) ) (list str) ) ) ;Principal (defun c:atbybl (/ cpt nbl atts dir ldwg axdoc) (if (setq cpt 0 nbl (getstring "Nom du bloc ?") atts (str2lst (getstring "Etiquettes ? (séparées par ; )")";") dir (getdir) ldwg (vl-directory-files dir "*.dwg" 1) ) (progn (foreach dwg ldwg (setq dwg (strcat dir dwg) axdoc (getaxdbdoc dwg)) (if (attbyblock nbl atts axdoc) (vla-saveas axdoc dwg) ) (vlax-release-object axdoc) (setq cpt (1+ cpt)) ) (princ (strcat "\n " (itoa cpt) " dwg traités")) ) (princ "\n Abandon, aucun dwg dans le dossier.") ) (princ) ) Cela fonctionne sur les blocs en espace objet tu tape atbybl , tu seras invité à saisir le nom du bloc et la liste des étiquettes des attributs puis choisir un dossier (je n'ai pas choisi l'option sous-dossier pas sécurité) pas de retour possible fais un essais sur une copie de dossier avant.

Pas tant que cela, et en donnant une limite de longueur au ligne, tu obtient la même chose (à peu près) que algorithme cité par contre si on ne fait pas attention, il y a beaucoup d'itérations

Bonjour, Je ne suis pas sur d'avoir compris le truc Mais il me semble avoir rencontrer un problème similaire avec des points que j'ai reliés en traçant une ligne entre chaque, ce qui m'a donner un polygone fermé. tu peux le faire pour chaque poignées aussi

Bonjour, C'est aux "clac, clac clac ..." que fait la barre espace, qu'on sait si un dessinateur est actif.... Pour les rotations, tu sélectionnes une poignée et "clac clac"

Bonjour, Je vais retenir principalement qu'append est moins efficient que reverse + cons. C'est pas évidant de prime abord. Bruno, à tu fait les testes avec une très grande liste?

Bonjour Le numéro du message est tout en haut dans la barre d'adresse de ton navigator.

Merci pour ce cadeau de pâque je vais le déguster avec attention

en déplaçant des setq , pas sur que se soit plus véloce. (defun coup-if-not (fct lst / posl ret ltmp el2) (setq posl -1) (foreach el1 lst (if (not ltmp)(setq ltmp (list el1))) (if (and (setq el2 (nth (1+ (setq posl (1+ posl))) lst))(apply fct (list el1 el2))) (setq ltmp (append ltmp (list el2))) (setq ret (append ret (list ltmp)) ltmp nil) ) ) (if ltmp (append ret (list ltmp)) ret) ) (defun coup-if (fct lst / posl ret ltmp el2) (setq posl -1) (foreach el1 lst (if (not ltmp)(setq ltmp (list el1))) (if (and (setq el2 (nth (1+ (setq posl (1+ posl))) lst)) (not(apply fct (list el1 el2)))) (setq ltmp (append ltmp (list el2))) (setq ret (append ret (list ltmp)) ltmp nil) ) ) (if ltmp (append ret (list ltmp)) ret) ) Suppression d'un append inutile

avec un foreach à la place du vilain repeat (defun coup-if-not (fct lst / posl ret ltmp el2) (setq posl 0) (foreach el1 lst (setq el2 (nth (1+ posl) lst)) (if (not ltmp)(setq ltmp (append ltmp (list el1)))) (if (and el2 (apply fct (list el1 el2))) (setq ltmp (append ltmp (list el2))) (setq ret (append ret (list ltmp)) ltmp nil) ) (setq posl (1+ posl)) ) (if ltmp (append ret (list ltmp)) ret) ) (defun coup-if (fct lst / posl ret ltmp el2) (setq posl 0) (foreach el1 lst (setq el2 (nth (1+ posl) lst)) (if (not ltmp)(setq ltmp (append ltmp (list el1)))) (if (and el2 (not(apply fct (list el1 el2)))) (setq ltmp (append ltmp (list el2))) (setq ret (append ret (list ltmp)) ltmp nil) ) (setq posl (1+ posl)) ) (if ltmp (append ret (list ltmp)) ret) )

je crois que j’atteins mes limites (temporaires) d'abstraction par contre Gile nous à fait un "reversing" renversant

Voici donc ma solution (avec l'aide gile) (defun coup-if-not (fct lst / posl ret ltmp el1 el2) (setq posl 0) (repeat (length lst) (setq el1 (nth posl lst) el2 (nth (1+ posl) lst)) (if (not ltmp)(setq ltmp (append ltmp (list el1)))) (if (and el2 (apply fct (list el1 el2))) (setq ltmp (append ltmp (list el2))) (setq ret (append ret (list ltmp)) ltmp nil) ) (setq posl (1+ posl)) ) (if ltmp (append ret (list ltmp)) ret) ) (defun coup-if (fct lst / posl ret ltmp el1 el2) (setq posl 0) (repeat (length lst) (setq el1 (nth posl lst) el2 (nth (1+ posl) lst)) (if (not ltmp)(setq ltmp (append ltmp (list el1)))) (if (and el2 (not(apply fct (list el1 el2)))) (setq ltmp (append ltmp (list el2))) (setq ret (append ret (list ltmp)) ltmp nil) ) (setq posl (1+ posl)) ) (if ltmp (append ret (list ltmp)) ret) )

Jolie récursivité Je vois que tu as émit d'autre liste d'exception, il y en a d'autre encore... cela doit dépendre du langage qui tourne sur le serveur qui héberge la page (php, java, phyton ..) Je pense, après coup, que pour rendre plus générique ces fonctions qu'il faudrait mettre cette liste en argument