Patrick_35

Salut J'ai corrigé 2/3 petites choses (defun c:lg (/ p1 p2 file) (setq file (open "c:\\Distances.txt" "w")) (while (setq p1 (getpoint "\nSpécifiez le premier point : ")) (setq p2 (getpoint p1 "\nSpécifiez le second point : ")) (setq dist (distance p1 p2)) (write-line (rtos dist) file) ) (close file) ) @+

Je ne vois pas les résultats avec le screencast. Tu peux donner un exemple avec le résultat attendu. @+

Le lisp travail avec le scu courant ??? @+

Salut A partir de ce lisp (defun c:atm(/ att doc ent grr new pt1 pt2 mlead gc:3dPointListToVariant) (defun gc:3dPointListToVariant (lst) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-VbDouble (cons 0 (1- (* 3 (length lst)))) ) (apply 'append lst) ) ) ) (defun mlead(pt2 / pts) (setq pts (gc:3dPointListToVariant (list (trans pt1 1 0) (trans pt2 1 0)))) (if new (progn (vla-setleaderlinevertices new 0 pts) (vla-setdoglegdirection new 0 (vlax-3D-point (trans (list (if (> (car pt2) (car pt1)) 1 -1) 0 0) 1 0 T))) (vla-update new) ) (progn (setq new (vla-addmleader (vla-get-modelspace doc) pts 0)) (vla-put-textstring new att) (vla-rotate new (vlax-3d-point (trans pt2 1 0)) (angle (trans '(0 0 0) 1 0) (trans '(1 0 0) 1 0)) ) ) ) ) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (while (setq ent (entsel "\nSélectionnez un bloc : ")) (and (setq ent (vlax-ename->vla-object (car ent))) (eq (vla-get-objectname ent) "AcDbBlockReference") (eq (vla-get-hasattributes ent) :vlax-true) (setq att (vl-remove-if-not '(lambda(x)(eq (strcase (vla-get-tagstring x)) "REPERE")) (vlax-invoke ent 'getattributes))) (setq att (vla-get-textstring (car att))) (setq pt1 (getpoint "\n1er point : ")) (setq new nil pt2 pt1) (princ "\n2em point : ") (while (and pt2 (setq grr (grread t 9 0)) (vl-position (car grr) '(2 3 5)) ) (cond ((= (car grr) 3)(setq pt2 nil)) ((= (car grr) 5)(mlead (cadr grr))) (T (setq pt2 nil)(if new (vla-delete new))) ) ) ) ) (vla-endundomark doc) (princ) ) @+

Salut J'ai amélioré la routine pour fonctionner sur n'importe quel réel. (defun c:ajt(/ dmz doc ele lst split) (defun split(txt / deb fin loc lst pos str) (setq str 1 loc 0) (while (setq pos (vl-string-search "." txt loc)) (setq deb (1+ pos) fin deb) (while (and (> deb 1) (eq (type (read (substr txt (1- deb) 1))) 'INT)) (setq deb (1- deb))) (while (eq (type (read (substr txt (1+ fin) 1))) 'INT) (setq fin (1+ fin))) (or (eq deb fin) (setq lst (cons (read (strcat "0" (substr txt deb (1+ (- fin deb))))) (cons (substr txt str (- deb str)) lst ) ) str (1+ fin) ) ) (setq loc (1+ pos)) ) (reverse (cons (substr txt str) lst)) ) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (initget 3) (and (setq val (getreal "\nValeur à ajouter : ")) (ssget) (setq dmz (getvar "dimzin")) (setvar "dimzin" 0) (vlax-for ele (setq sel (vla-get-activeselectionset doc)) (and (vlax-property-available-p ele 'textstring) (setq lst (mapcar '(lambda(x)(if (eq (type x) 'STR) x (rtos (+ x val)))) (split (vla-get-textstring ele)))) (vla-put-textstring ele (apply 'strcat lst)) ) ) (vla-delete sel) (setvar "dimzin" dmz) ) (vla-endundomark doc) (princ) ) @+

Salut C'est juste la ligne (cons 50 (dxf 50 en)) à ajouter dans le lisp que tu as fournit. J'ai donné un morceau de code plus complet pour indiquer où mettre cette ligne. @+

Salut C'est mon tour (defun c:ajt(/ doc ele lst tag val split) (defun split(txt tag / loc lst pos str val) (setq str 1 loc 0 ) (while (setq pos (vl-string-search "." txt loc)) (if (and (> pos (1- (vl-string-search "." tag))) (wcmatch (setq val (substr txt (- pos (- (strlen tag) (vl-string-search "." tag) 1)) (strlen tag))) tag)) (setq deb (substr txt str (- pos str (- (strlen tag) (vl-string-search "." tag) 1))) str (+ pos (- (strlen tag) (vl-string-search "." tag)) 1) lst (cons (read val) (cons deb lst)) ) ) (setq loc (1+ pos)) ) (reverse (cons (substr txt str) lst)) ) (setq doc (vla-get-activedocument (vlax-get-acad-object)) tag "###.##" ; Modèle de recherche --> 3 valeurs numérique + "." + 2 valeurs numérique ) (vla-startundomark doc) (initget 3) (and (setq val (getreal "\nValeur à ajouter : ")) (ssget) (vlax-for ele (setq sel (vla-get-activeselectionset doc)) (and (vlax-property-available-p ele 'textstring) (setq lst (mapcar '(lambda(x)(if (eq (type x) 'STR) x (rtos (+ x val)))) (split (vla-get-textstring ele) tag))) (vla-put-textstring ele (apply 'strcat lst)) ) ) (vla-delete sel) ) (vla-endundomark doc) ) @+ ps : attention à la précision des unités (ddunits)

Si c'est juste une altitude à changer, rechercher/remplacer fera l'affaire. Si il faut ajouter 0.04 sur plusieurs altitudes, il faut passer par un lisp. @+

Oui. On peut même pousser le test plus loin (if (eq (type (eval 'c:CtrlSvGrd)) 'SUBR) (c:CtrlSvGrd) (princ "La commande CtrlSvGrd n'est pas disponible") ) ;_ Fin de if @+

Salut Je vais peut-être répondre à coté Avec la fonction Rechercher/Remplacer ? @+

Salut Avec la fonction eval Par exemple (eval 'c:mon_lisp) @+

Salut Dans le lisp que tu as joint. @+

Salut Lecrabe Ton lisp ne fonctionne pas correctement. Déjà il demande un bloc existant. Si le bloc a des attributs, le remplissage n'est pas correcte. Si le bloc n'a pas d'attributs, et bien le texte est remplacé par le bloc. Sinon, il faut logiquement remplacer (command "._-insert" blkName p10 "" "" "" text) ;; ._-insert par (command "._-insert" blkName p10 "" "" (* 180.0 (/ (cdr (assoc 50 e)) pi)) text) ;; ._-insert @+

Salut Tu ajoutes cette ligne (cons 50 (dxf 50 en)) ; *************** Insert the block ****** (entmake (list '(0 . "INSERT") '(100 . "AcDbEntity") (cons 8 lyr) '(100 . "AcDbBlockReference") '(66 . 1) (cons 2 bname) (cons 10 ins-pt) ) ;_ list ) ;_ entmake (entmake (list '(0 . "ATTRIB") '(100 . "AcDbEntity") (cons 8 lyr) '(100 . "AcDbText") (cons 10 ins-pt) (cons 40 txt-ht) (cons 50 (dxf 50 en)) (cons 1 txt-str) (cons 7 txt-style) '(100 . "AcDbAttribute") (cons 2 t-str) '(70 . 0) ) ;_ list ) ;_ entmake @+ ps : le surlignage ne passe pas dans les balises code

Tu peux modifier le lisp afin qu'il corresponde à tes besoins A supprimer (or (vl-catch-all-error-p (vl-catch-all-apply 'vla-explode (list obj))) (vla-delete obj) ) A supprimer (while (< (strlen lay) 3) (setq lay (strcat "0" lay)) ) (and (vl-catch-all-error-p (vl-catch-all-apply 'vla-add (list (vla-get-layouts doc) lay))) (ssget "x" (list (cons 410 lay))) (progn (vlax-map-collection (setq sel (vla-get-activeselectionset doc)) 'vla-delete) (vla-delete sel) ) ) (vla-put-activelayout doc (setq tab (vla-item (vla-get-layouts doc) lay))) (setq fen (vla-addpviewport (vla-get-block tab) (vlax-3d-point (mapcar '(lambda(a B) (/ (+ a B) 2.0)) bg hd)) dix diy)) (vla-put-layer fen "0") (vla-put-color fen "256") (vla-put-viewporton fen :vlax-true) (vla-zoomextents (vlax-get-acad-object)) (vla-display fen :vlax-false) (vla-display fen :vlax-true) (vla-put-mspace doc :vlax-true) (vla-zoomWindow (vlax-get-acad-object) (vlax-3d-point bg) (vlax-3d-point hd)) (vla-put-mspace doc :vlax-false) (vla-put-displaylocked fen :vlax-true) A modifier en fonction de tes besoins (setq tot (1+ tot) col (1+ col) x (+ x (* dix 1.05)) ) (and (> diy my) (setq my diy) ) (and (eq col 10) (setq x 0.0 y (+ y (* my 1.05)) my 0.0 col 1 ) ) Il reste à ajouter le texte, je te laisse chercher... @+

Salut Tu as ce sujet @+

Salut un exemple pour un entête sur deux lignes Insérer un entête sur deux lignes (setq oo-sty (vlax-invoke (vlax-get oo-doc 'StyleFamilies) 'getByName "PageStyles")) (setq oo-pge (vlax-invoke oo-sty 'getByName (vlax-get oo-obj 'PageStyleName))) (vlax-put oo-pge 'HeaderIsOn :vlax-true) (vlax-put oo-pge 'HeaderBodyDistance 1000) (vlax-put oo-pge 'HeaderHeight 2500) (setq oo-txt (vlax-get oo-pge 'HeaderText)) (setq oo-cur (vlax-invoke oo-txt 'createTextCursor)) (vlax-put oo-cur 'paraAdjust 3) (vlax-invoke oo-txt 'insertString oo-cur (strcat "Mon_Texte 1" (chr 10) "Mon_texte 2") :vlax-false) @+

J'ai continué mes recherches Insérer un entête (setq oo-sty (vlax-invoke (vlax-get oo-doc 'StyleFamilies) 'getByName "PageStyles")) (setq oo-pge (vlax-invoke oo-sty 'getByName (vlax-get oo-obj 'PageStyleName))) (vlax-put oo-pge 'HeaderIsOn :vlax-true) (setq oo-txt (vlax-get oo-pge 'HeaderText)) (setq oo-cur (vlax-invoke oo-txt 'createTextCursor)) (vlax-put oo-cur 'paraAdjust 3) (vlax-invoke oo-txt 'insertString oo-cur "Mon_Texte" :vlax-false) Insérer un pied de page (setq oo-sty (vlax-invoke (vlax-get oo-doc 'StyleFamilies) 'getByName "PageStyles")) (setq oo-pge (vlax-invoke oo-sty 'getByName (vlax-get oo-obj 'PageStyleName))) (vlax-put oo-pge 'FooterIsOn :vlax-true) (setq oo-txt (vlax-get oo-pge 'FooterText)) (setq oo-cur (vlax-invoke oo-txt 'createTextCursor)) (vlax-put oo-cur 'paraAdjust 1) (vlax-invoke oo-txt 'insertString oo-cur "Page 1/1" :vlax-false) @+

Salut Steven J'ai regardé ton bloc et tes attributs sont bien sur le calque 0, etc... ? Même en insérant le bloc, je ne vois pas, dans les propriétés de l'éditeur d'attributs étendu, où est le problème. @+

Salut Une fonction reprise depuis Api_xls ;------------------------------------------------------------------- ; ; Convertir une chaine de caractères de type UTF-8 ; Convert a string to UTF-8 ; ; Exemple ; (decodeurl "c:\\Donn%C3%A9es") --> "c:\\Données" ; ;------------------------------------------------------------------- (defun decodeurl(str / hex new pos txt hexdec) (defun hexdec (nb / r i s) (if (= (type nb) 'INT) (setq nb (itoa nb)) ) (setq r 0 i 0) (while (and (= (type nb) 'STR) (< i (strlen nb))) (setq i (1+ i) s (strcase (substr nb i 1 )) r (+ (lsh r 4) (- (ascii s) (if (<= s "9") 48 55))) ) ) ) (while (setq pos (vl-string-search "%" str)) (setq hex (substr str (+ pos 2) 2)) (and (eq (substr str (+ pos 4) 1) "%") (setq hex (strcat hex (substr str (+ pos 5) 2))) ) (setq txt (strcat (substr str 1 pos) (if (eq (strlen hex) 4) (chr (- 50322 (hexdec hex))) (chr (hexdec hex)) ) ) ) (if (eq (strlen hex) 4) (setq str (substr str (+ pos 7))) (setq str (substr str (+ pos 4))) ) (if new (setq new (strcat new txt)) (setq new txt) ) ) (if new (strcat new str) str ) ) Pour ouvrir un document .odt (setq fil (getfiled "Veuillez sélectionner un fichier LibreOffice Writer" (getvar "dwgprefix") "odt" 16)) (setq oo-app (vlax-create-object "com.sun.star.ServiceManager")) (setq oo-des (vlax-invoke oo-app 'createinstance "com.sun.star.frame.Desktop")) (setq oo-doc (vlax-invoke-method oo-des 'loadComponentFromURL (decodeurl (strcat "file:///" (vl-string-translate "\\" "/" fil))) "_blank" 0 (vlax-make-safearray vlax-vbVariant '(0 . 0)))) @+

Salut Avec AddVtx&DelVtx de (gile) @+

Salut J'avais 5mn et tu es tombé au bon moment. J'avais oublié le / dans le nom de la fonction. C'est corrigé. @+

Salut Par exemple (defun c:rat(/ doc ent lst txt) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (while (setq ent (entsel "\nSélectionnez un bloc : ")) (and (setq ent (vlax-ename->vla-object (car ent))) (eq (vla-get-objectname ent) "AcDbBlockReference") (eq (vla-get-hasattributes ent) :vlax-true) (progn (setq lst nil) (while (setq txt (entsel "\nSélectionnez un texte (entrée = FIN) : ")) (and (setq txt (vlax-ename->vla-object (car txt))) (vlax-property-available-p txt 'textstring) (setq lst (cons (vla-get-textstring txt) lst)) ) ) (and lst (mapcar '(lambda(a B) (vla-put-textstring a B)) (vlax-invoke ent 'getattributes) (reverse lst)) ) ) ) ) (vla-endundomark doc) (princ) ) @+

Salut Je l'ai bien sur mon Autocad 2014 @+

Il est certain que si j'enlève un niveau, cela va tout de suite mieux. Mais avec 3.50m et un faux-plafond à 2.70, même avec 25cm de dalle, il reste quand même 55cm. Mais pourquoi 2.70. D'habitude on est plus sur 2.50 ? @+