Aller au contenu

Hydro8

Membres
  • Compteur de contenus

    227
  • Inscription

  • Dernière visite

Tout ce qui a été posté par Hydro8

  1. Je pense je vais changer mon fusil d'épaule. Je vais séparer la fonction pour faire la flèche car je pourrais l'utiliser pour d'autre texte. Du coup d'un côté la fonction pour la surface + contour et de l'autre la fonction pour faire la ligne du bas du mtext + la flèche.
  2. J'arrive au type de texte (altitude, sans hauteur...), je choisis un type, j'ai l'erreur : Commande: HYDRO8_POLY Développé par Denis H. (v:2.1)Commande inconnue "HYDRO8_POLY". Appuyez sur F1 pour obtenir de l'aide. Options des textes [Texte/Nombre/Contour/Polyligne] <VarB0> : Choisir le contour : Début calcul flèche Pointe de la flèche : Pied de la flèche (insertion du texte : Choix des textes [Altitudes/sansProfondeur/sansHauteur/sansLimite] <Altitudes> : l Calcul du gisement de la flèche selon son sensparamètre de la variable AutoCAD rejeté: "clayer" nil Au final j'obtiens le contour, la flèche mais pas le texte et la commande ne s'enchaîne pas.
  3. A si les décimales doivent apparaître dans le xdata mais aussi dans le texte qu'on affiche :unsure:
  4. Il va falloir que je vois ça, de mémoire je n'avais pas cette erreur avant. Il faudrait 2 décimales, ddunits est défini sur 4. J'ai relancer autocad plusieurs fois après les changements pour être sûr. Je vais essayé de comparer nos versions pour voir de quelle ligne peut provenir le problème.
  5. Je l'ai mis dans un lisp à part comme pour les autres petites commandes que tu m'as demandé. Je ne peux pas l'appeler comme ça, j'imagine c'est normal ou alors il faut que je rajoute c: devant son nom de commande.
  6. Est-il possible pour un getstring d'avoir une valeur par défaut ? Quand j'interroge sur l'altitude j'aimerais avoir la première fois XXXX.XX et les autres fois la valeur rentrée précédemment (ou XXXX.XX si rien rentré). Peut-on également obligatoirement sauvegarder les altitudes à 2 décimales dans le xdata ? Par exemple 192 devient 192.00.
  7. J'ai aussi ce message quand j'ouvre un dessin, je ne sais pas si ca a un rapport : Affectation à un symbole protégé: c:bb Voulez-vous entrer une boucle d'arrêt ?
  8. Mince du coup maintenant avec ton lisp il me dit qu'il trouve pas de fonction gisment.
  9. Non malheureusement j'ai toujours l'erreur même avec la fonction pour le gisement. Si j'enlève la partie sur le gisement, ça bug sur la partie pour calculer les points. Voici mon dernier code valide : ;;; *********************************************************** ;;; Dessine un contour, puis place un texte incrémenté et la ;;; surface dans un multitexte et dans des Xdata ;;; Pour Hydro8 de CadXP.com ;;; *********************************************************** (defun c:Hydro8_Poly (/ old_osmd PrefixIncrement ValIncrement Option1 Option2 MText EcritText) (princ "\nDéveloppé par Denis H. (v:2.0)") ;; Applique une matrice de transformation à un vecteur (Vladimir Nesterovsky) (defun mxv (m v) (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)) ;_ Fin de defun (defun EcritText (/ xSurf xMatri xBasse xHaute Pt_Deb_Fle) ;; (setq xMatri (strcat PrefixIncrement (itoa ValIncrement))) (SetXdataForApplication (entlast) "Matri" (list (cons 1000 xMatri))) (setq xSurf (rtos (getpropertyvalue (entlast) "Area") 2 1)) (SetXdataForApplication (entlast) "Surf" (list (cons 1000 xSurf))) ;; (setq Pt_Deb_Fle (getpoint "\nCliquer l'emplacement du texte :")) ;_ Fin de setq ;; (initget "Altitudes sansProfondeur sansHauteur sansLimite") (setq Option3 (getkword (strcat "\nChoix des textes [Altitudes/sansProfondeur/sansHauteur/sansLimite] <Altitudes> : ") ;_ Fin de strcat ) ;_ Fin de getkword ) ;_ Fin de setq (cond ( (= Option3 "Altitudes") (setq basse (getstring "Quelle est l'altitude basse ? ") ) (setq haute (getstring "Quelle est l'altitude haute ? ") ) (setq xBasse basse) (SetXdataForApplication (entlast) "Basse" (list (cons 1000 xBasse))) (setq xHaute haute) (SetXdataForApplication (entlast) "Haute" (list (cons 1000 xHaute))) (setq Opt3 (strcat basse "m et " haute "m") ) ) ( (= Option3 "sansProfondeur") (setq haute (getstring "Quelle est l'altitude haute ? ") ) (setq xBasse "----") (SetXdataForApplication (entlast) "Basse" (list (cons 1000 xBasse))) (setq xHaute haute) (SetXdataForApplication (entlast) "Haute" (list (cons 1000 xHaute))) (setq Opt3 (strcat "sans limitation\\Pen profondeur et " haute "m") ) ) ( (= Option3 "sansHauteur") (setq basse (getstring "Quelle est l'altitude basse ? ") ) (setq xBasse basse) (SetXdataForApplication (entlast) "Basse" (list (cons 1000 xBasse))) (setq xHaute "----") (SetXdataForApplication (entlast) "Haute" (list (cons 1000 xHaute))) (setq Opt3 (strcat basse "m et sans\\Plimitation en hauteur") ) ) ( (= Option3 "sansLimite") (setq xBasse "----") (SetXdataForApplication (entlast) "Basse" (list (cons 1000 xBasse))) (setq xHaute "----") (SetXdataForApplication (entlast) "Haute" (list (cons 1000 xHaute))) (setq Opt3 "sans limitation en\\Pprofondeur et en hauteur") ) (T (setq basse (getstring "Quelle est l'altitude basse ? ")) (setq haute (getstring "Quelle est l'altitude haute ? ")) (setq xBasse basse) (SetXdataForApplication (entlast) "Basse" (list (cons 1000 xBasse))) (setq xHaute haute) (SetXdataForApplication (entlast) "Haute" (list (cons 1000 xHaute))) (setq Opt3 (strcat basse "m et " haute "m")) ) ) (setq MText (strcat "\\H0.53\\o" PrefixIncrement (itoa ValIncrement) "\\o\\P\\H0.38S=" xSurf "m²\\PNGF : " Opt3)) (command "_.-MTEXT" Pt_Deb_Fle "J" "MC" "H" 1.0 Pt_Deb_Fle MText "") ;; ;; ;;;Défini les quatre coins du MText de (gile) (princ "\nDéfini les quatre coins du MText de (gile)") (setq MTxt (entlast)) (setq elst (entget (entlast))) (if (= "MTEXT" (cdr (assoc 0 (entget (entlast))))) (setq nor (cdr (assoc 210 elst)) ref (trans (cdr (assoc 10 elst)) 0 nor) rot (angle '(0 0 0) (trans (cdr (assoc 11 elst)) 0 nor)) wid (cdr (assoc 42 elst)) hgt (cdr (assoc 43 elst)) jus (cdr (assoc 71 elst)) org (list (cond ((member jus '(2 5 8)) (/ wid -2)) ((member jus '(3 6 9)) (- wid)) (T 0.0) ) ;_ Fin de cond (cond ((member jus '(1 2 3)) (- hgt)) ((member jus '(4 5 6)) (/ hgt -2)) (T 0.0) ) ;_ Fin de cond ) ;_ Fin de list plst (mapcar (function (lambda (p) (mapcar '+ org p))) (list (list (- 0.1) (- 0.1)) (list (+ wid 0.1) (- 0.1)) (list (+ wid 0.1) (+ hgt 0.1)) (list (- 0.1) (+ hgt 0.1)) ) ;_ Fin de list ) ;_ Fin de mapcar ) ;_ Fin de setq (setq box (textbox elst) ref (cdr (assoc 10 elst)) rot (cdr (assoc 50 elst)) plst (list (list (- (caar box) 0.1) (- (cadar box) 0.1)) (list (+ (caadr box) 0.1) (- (cadar box) 0.1)) (list (+ (caadr box) 0.1) (+ (cadadr box) 0.1)) (list (- (caar box) 0.1) (+ (cadadr box) 0.1)) ) ;_ Fin de list ) ;_ Fin de setq ) ;_ Fin de if (setq mat (list (list (cos rot) (- (sin rot)) 0) (list (sin rot) (cos rot) 0) '(0 0 1)) ;_ Fin de list plst (mapcar (function (lambda (p) (mapcar '+ (mxv mat p) (list (car ref) (cadr ref)))) ;_ Fin de lambda ) ;_ Fin de function plst ) ;_ Fin de mapcar ) ;_ Fin de setq (setq Pt1 (list (car (nth 0 plst)) (cadr (nth 0 plst)))) (setq Pt2 (list (car (nth 1 plst)) (cadr (nth 1 plst)))) (setq Pt3 (list (car (nth 2 plst)) (cadr (nth 2 plst)))) (setq Pt4 (list (car (nth 3 plst)) (cadr (nth 3 plst)))) ;(setvar "osmode" 0) ;; (command "_.pline" Pt1 Pt2 "") ;_ Fin de command ;;; paramètres de la flèche (c:DH_Fleche) (vlax-ldata-put "DenisH" "ValIncrement" (+ ValIncrement 1)) (setq ValIncrement (vlax-ldata-get "DenisH" "ValIncrement")) ) ;_ Fin de defun ;;; Active le début de l'undo (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (setq old_cmdecho (getvar "cmdecho") old_osmode (getvar "osmode") ) ;_ Fin de setq (setvar "clayer" "0") (setvar "cmdecho" 0) (if (not (tblsearch "layer" "MARTY-SURFACES_FRACTIONS")) (command "-calque" "e" "MARTY-SURFACES_FRACTIONS" "co" "u" "255,0,255" "MARTY-SURFACES_FRACTIONS" "") ;_ Fin de command (command "-calque" "ch" "MARTY-SURFACES_FRACTIONS" "") ) ;_ Fin de if (setq PrefixIncrement (vlax-ldata-get "DenisH" "PrefixIncrement" "1a")) (if (= PrefixIncrement nil) (vlax-ldata-put "DenisH" "PrefixIncrement" "1a") ) ;_ Fin de if (setq ValIncrement (vlax-ldata-get "DenisH" "ValIncrement" 0)) (if (or (= ValIncrement "") (= ValIncrement nil)) (progn (vlax-ldata-put "DenisH" "ValIncrement" 0) (setq ValIncrement (vlax-ldata-get "DenisH" "ValIncrement")) ) ;_ Fin de progn ) ;_ Fin de if (if (not (tblsearch "style" "Surface")) (command "-style" "Surface" "arial.ttf" "" "" "" "" "" "") ) ;_ Fin de if (command "textstyle" "Surface") (while (/= (type Option1) 'LIST) (initget "Texte Nombre Contour Polyligne") (setq Option1 (getkword (strcat "\nOptions des textes [Texte/Nombre/Contour/Polyligne] <" PrefixIncrement (itoa ValIncrement) "> : " ) ;_ Fin de strcat ) ;_ Fin de getkword ) ;_ Fin de setq (cond ((= Option1 "Texte") (setq PrefixIncrement (getstring (strcat "\nSaisir le préfix de l'incrémentation <" PrefixIncrement "> : ")) ;_ Fin de getstring ) ;_ Fin de setq (vlax-ldata-put "DenisH" "PrefixIncrement" PrefixIncrement) ) ((= Option1 "Nombre") (setq ValIncrement (getint "\nSaisir le prochain numéro de l'incrémentation : ")) ;_ Fin de getstring (if (or (= ValIncrement "") (= ValIncrement nil)) (vlax-ldata-put "DenisH" "ValIncrement" 0) (vlax-ldata-put "DenisH" "ValIncrement" ValIncrement) ) ;_ Fin de if ) ((= Option1 "Contour") (while (princ "\nChoisir le contour :") (command "-contour" "O" "O" "P" "" pause "") (EcritText)) ) ((= Option1 "Polyligne") (while (princ "\nSaisisser le contour :") (command "_.pline" (while (not (zerop (getvar "cmdactive"))) (command pause)) ;_ Fin de while ) ;_ Fin de command (EcritText) ;_ Fin de command ) ;_ Fin de while ) (T (while (princ "\nChoisir le contour :") (command "-contour" "O" "O" "P" "" pause "") (EcritText)) ) ;_ Fin de cond ) ;_ Fin de while ) ;_ Fin de while (setvar "osmode" old_osmode) (setvar "cmdecho" old_cmdecho) (setvar "plinewid" 0) ;;; Fin de l'undo (vla-endundomark doc) (princ) ) ;_ Fin de defun
  10. Edit : j'ai rien dit. J'ai ajouté la fonction mais cela ne change rien. La commande continue si je supprime le calcul du gisement et le calcul des points de mtext.
  11. Cela créer le calque. Il n'y a t'il pas une commande un peu particulière pour le calcul du gisement un peu comme MXV ?
  12. Merci beaucoup ! Effectivement on a gagne du temps, cependant j'ai l'erreur : Calcul du gisement de la flèche selon son sensparamètre de la variable AutoCAD rejeté: "clayer" nil Quand je sélectionne l'option pour l'altitude du texte.
  13. Pour le traite sur deux points, j'ai rien dit ça fonctionne, j'ai confondu avec le surlignage :unsure:
  14. Désolé pour VarB j'aurais dû le voir tout seul <_< Je comprend pour le milieu du polygone, en plus suivant le polygone ca doit faire quelque chose de bizarre. Peut-être peut-on bloquer la commande pour ne pas faire "entrée" ou "espace" à ce moment là sinon la commande continue mais ne donnera rien.
  15. Oui encore merci, on dirait qu'il y a des lisp de base qu'il faudrait que j'ai. Alors alors, concernant le dernier code il m'affiche toujours VAR au début et fonctionne normalement si je change le préfix. Peut-être est ce lié à une variable non défini au premier lancement du code ? Est ce que c'est possible et pas trop chiant : - si pas de point pour le texte, le mettre au milieu du polygone ? - un menu pour la flèche pour dire si on a besoin d'une flèche (donc contour + flèche) ou si pas besoin (donc pas de contour ni de flèche) - tracer le cadre du texte que sur deux points ? j'ai testé d'enlever deux points du pline mais ça à pas l'air de marcher.
  16. Donc avec ce code : ;; mxv Apply a transformation matrix to a vector by Vladimir Nesterovsky (defun mxv (m v) (mapcar '(lambda (row) (apply '+ (mapcar '* row v))) m) ) ;; mxm Multiply two matrices by Vladimir Nesterovsky (defun mxm (m q / qt) (setq qt (apply 'mapcar (cons 'list q))) (mapcar '(lambda (mrow) (mxv qt mrow)) m) ) Cela fonctionne !!!! Merci à vous deux ! Bon je fais mumuse avec et je reviens.
  17. Héhé je pense que lecrabe vient de mettre le point sur le problème, quand je commente la ligne avec MXV j'ai bien tout sauf le cadre.
  18. J'essaye de voir de quelle ligne provient l'erreur :/
  19. Ok donc en utilisant ce code ça fonctionne (sauf l'erreur VAR mais bon cest surement pas grand chose ça): ;;; *********************************************************** ;;; Dessine un contour, puis place un texte incrémenté et la ;;; surface dans un multitexte et dans des Xdata ;;; Pour Hydro8 de CadXP.com ;;; *********************************************************** (defun c:Hydro8_Poly (/ old_osmd PrefixIncrement ValIncrement Option1 Option2 MText EcritText) (princ "\nDéveloppé par Denis H. (v:1.8)") (defun EcritText (/ xSurf xMatri Pt_Deb_Fle) ;; (setq xMatri (strcat PrefixIncrement (itoa ValIncrement))) (SetXdataForApplication (entlast) "Matri" (list (cons 1000 xMatri))) (setq xSurf (rtos (getpropertyvalue (entlast) "Area") 2 1)) (SetXdataForApplication (entlast) "Surf" (list (cons 1000 xSurf))) ;; (setq Pt_Deb_Fle (getpoint "\nCliquer l'emplacement du texte :")) ;_ Fin de setq ;; (initget "Altitudes sansProfondeur sansHauteur sansLimite") (setq Option3 (getkword (strcat "\nChoix des textes [Altitudes/sansProfondeur/sansHauteur/sansLimite] <Altitudes> : ") ;_ Fin de strcat ) ;_ Fin de getkword ) ;_ Fin de setq (cond ((= Option3 "Altitudes") (setq Opt3 "Altitudes")) ((= Option3 "sansProfondeur") (setq Opt3 "sans profondeur")) ((= Option3 "sansHauteur") (setq Opt3 "sans hauteur")) ((= Option3 "sansLimite") (setq Opt3 "sans limite")) (T (setq Opt3 "Altitudes")) ) ;_ Fin de cond (setq MText (strcat "\\H1.2\\L" PrefixIncrement (itoa ValIncrement) "\\P\\H1S=" xSurf "m²\\P" Opt3 "\\l")) (command "_.-MTEXT" Pt_Deb_Fle "J" "MC" "H" 1.0 Pt_Deb_Fle MText "") ;; (vlax-ldata-put "DenisH" "ValIncrement" (+ ValIncrement 1)) (setq ValIncrement (vlax-ldata-get "DenisH" "ValIncrement")) ) ;_ Fin de defun ;;; Active le début de l'undo (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (setq old_cmdecho (getvar "cmdecho") old_osmode (getvar "osmode") ) ;_ Fin de setq (command "-calque" "e" "MARTY-SURFACES_FRACTIONS" "co" "u" "255,0,255" "MARTY-SURFACES_FRACTIONS" "") ;_ Fin de command ;_ Fin de command (setq PrefixIncrement (vlax-ldata-get "DenisH" "PrefixIncrement" "VarB")) (if (= PrefixIncrement nil) (vlax-ldata-put "DenisH" "PrefixIncrement" "VarB") ) ;_ Fin de if (setq ValIncrement (vlax-ldata-get "DenisH" "ValIncrement" 0)) (if (or (= ValIncrement "") (= ValIncrement nil)) (progn (vlax-ldata-put "DenisH" "ValIncrement" 0) (setq ValIncrement (vlax-ldata-get "DenisH" "ValIncrement")) ) ;_ Fin de progn ) ;_ Fin de if (if (not (tblsearch "style" "Surface")) (command "-style" "Surface" "arial.ttf" "" "" "" "" "" "") ) ;_ Fin de if (command "textstyle" "Surface") (while (/= (type Option1) 'LIST) (initget "Préfix Nombre Suivant") (setq Option1 (getkword (strcat "\nOptions des textes [Préfix/Nombre/Suivant] <" PrefixIncrement (itoa ValIncrement) "> : ") ;_ Fin de strcat ) ;_ Fin de getkword ) ;_ Fin de setq (cond ((= Option1 "Préfix") (setq PrefixIncrement (getstring (strcat "\nSaisir le préfix de l'incrémentation <" PrefixIncrement "> : ")) ;_ Fin de getstring ) ;_ Fin de setq (vlax-ldata-put "DenisH" "PrefixIncrement" PrefixIncrement) ) ((= Option1 "Nombre") (setq ValIncrement (getint "\nSaisir le prochain numéro de l'incrémentation : ")) ;_ Fin de getstring (if (or (= ValIncrement "") (= ValIncrement nil)) (vlax-ldata-put "DenisH" "ValIncrement" 0) (vlax-ldata-put "DenisH" "ValIncrement" ValIncrement) ) ;_ Fin de if ) ((= Option1 "Suivant") (initget "Contour Polyligne") (setq Option2 (getkword "\nOptions des textes [Contour/Polyligne] <Contour> : ") ;_ Fin de strcat ) ;_ Fin de getkword (cond ((or (= Option2 "Contour") (= Option2 nil)) ;_ Fin de or (while (princ "\nChoisir le contour :") (command "-contour" "O" "O" "P" "" pause "") (EcritText)) ) ((= Option2 "Polyligne") (while (princ "\nSaisisser le contour :") (command "_.pline" (while (not (zerop (getvar "cmdactive"))) (command pause)) ;_ Fin de while ) ;_ Fin de command (EcritText) ) ;_ Fin de while ) ) ;_ Fin de cond ) ) ;_ Fin de cond ) ;_ Fin de while (setvar "osmode" old_osmode) (setvar "cmdecho" old_cmdecho) (setvar "plinewid" 0) ;;; Fin de l'undo (vla-endundomark doc) (princ) ) ;_ Fin de defun
  20. Alors avec le dwg ça ne change rien. Le lisp de la flèche fonctionne bien. Du coup j'ai essayé en enlevant le bout de code du lisp poly, j'ai toujours l'erreur. Toutes ces lignes : ;;;Défini les quatre coins du MText de (gile) (princ "\nDéfini les quatre coins du MText de (gile)") (setq MTxt (entlast)) (setq elst (entget (entlast))) (if (= "MTEXT" (cdr (assoc 0 (entget (entlast))))) (setq nor (cdr (assoc 210 elst)) ref (trans (cdr (assoc 10 elst)) 0 nor) rot (angle '(0 0 0) (trans (cdr (assoc 11 elst)) 0 nor)) wid (cdr (assoc 42 elst)) hgt (cdr (assoc 43 elst)) jus (cdr (assoc 71 elst)) org (list (cond ((member jus '(2 5 8)) (/ wid -2)) ((member jus '(3 6 9)) (- wid)) (T 0.0) ) ;_ Fin de cond (cond ((member jus '(1 2 3)) (- hgt)) ((member jus '(4 5 6)) (/ hgt -2)) (T 0.0) ) ;_ Fin de cond ) ;_ Fin de list plst (mapcar (function (lambda (p) (mapcar '+ org p))) (list (list (- 0.1) (- 0.1)) (list (+ wid 0.1) (- 0.1)) (list (+ wid 0.1) (+ hgt 0.1)) (list (- 0.1) (+ hgt 0.1)) ) ;_ Fin de list ) ;_ Fin de mapcar ) ;_ Fin de setq (setq box (textbox elst) ref (cdr (assoc 10 elst)) rot (cdr (assoc 50 elst)) plst (list (list (- (caar box) 0.1) (- (cadar box) 0.1)) (list (+ (caadr box) 0.1) (- (cadar box) 0.1)) (list (+ (caadr box) 0.1) (+ (cadadr box) 0.1)) (list (- (caar box) 0.1) (+ (cadadr box) 0.1)) ) ;_ Fin de list ) ;_ Fin de setq ) ;_ Fin de if (setq mat (list (list (cos rot) (- (sin rot)) 0) (list (sin rot) (cos rot) 0) '(0 0 1)) ;_ Fin de list plst (mapcar (function (lambda (p) (mapcar '+ (mxv mat p) (list (car ref) (cadr ref)))) ;_ Fin de lambda ) ;_ Fin de function plst ) ;_ Fin de mapcar ) ;_ Fin de setq (setq Pt1 (list (car (nth 0 plst)) (cadr (nth 0 plst)))) (setq Pt2 (list (car (nth 1 plst)) (cadr (nth 1 plst)))) (setq Pt3 (list (car (nth 2 plst)) (cadr (nth 2 plst)))) (setq Pt4 (list (car (nth 3 plst)) (cadr (nth 3 plst)))) (setvar "osmode" 0) C'est pour avoir les quatres coins du texte c'est bien ça ? On dirait que c'est là que ça bloque.
  21. Merci pour tes recherches malheureusement toujours le même problème :( N'utilises tu pas une sous routine lisp pour la flèche qui n'est pas présente dans ce fichier comme pour les xdata ?
  22. Voila voila : https://we.tl/tqHGNDlCQC
  23. Toujours pas de flèche même avec les modifications. Le contour se créer bien, la surface est enregistrée, le texte apparait bien là où j'ai cliqué mais une fois insérer j'ai l'erreur : À priori en relation avec la définition de la flêche.
  24. Alors toujours le problème de clayer. Je ne sais pas si le problème vient du calque en lui même, j'ai l'impression que j'ai cette erreur dès qu'il y a un problème sur une autre commande. D'ailleurs on peut enlever la référence à tous calques pour essayer. Du coup j'ai essayé de modifier le code mais toujours pas de demande de flèche et toujours que la première ligne soulignée. Voici le code que j'utilise, je me suis peut-être trompé quelquepart dans les copier / coller : ;;; *********************************************************** ;;; Dessine un contour, puis place un texte incrémenté et la ;;; surface dans un multitexte et dans des Xdata ;;; Pour Hydro8 de CadXP.com ;;; *********************************************************** (defun c:Hydro8_Poly (/ old_osmd PrefixIncrement ValIncrement Option1 Option2 MText EcritText) (princ "\nDéveloppé par Denis H. (v:1.7)") (defun EcritText (/ xSurf xMatri Pt_Deb_Fle) ;; (setq xMatri (strcat PrefixIncrement (itoa ValIncrement))) (SetXdataForApplication (entlast) "Matri" (list (cons 1000 xMatri))) (setq xSurf (rtos (getpropertyvalue (entlast) "Area") 2 1)) (SetXdataForApplication (entlast) "Surf" (list (cons 1000 xSurf))) ;; (setq Pt_Deb_Fle (getpoint "\nCliquer l'emplacement du texte :")) ;_ Fin de setq ;; (initget "Altitudes sansProfondeur sansHauteur sansLimite") (setq Option3 (getkword (strcat "\nChoix des textes [Altitudes/sansProfondeur/sansHauteur/sansLimite] <Altitudes> : ") ;_ Fin de strcat ) ;_ Fin de getkword ) ;_ Fin de setq (cond ((= Option3 "Altitudes") (setq Opt3 "Altitudes")) ((= Option3 "sansProfondeur") (setq Opt3 "sans profondeur")) ((= Option3 "sansHauteur") (setq Opt3 "sans hauteur")) ((= Option3 "sansLimite") (setq Opt3 "sans limite")) (T (setq Opt3 "Altitudes")) ) ;_ Fin de cond (setq MText (strcat "\\H1.2\\L" PrefixIncrement (itoa ValIncrement) "\\l\\P\\H1S=" xSurf "m²\\P" Opt3)) (command "_.-MTEXT" Pt_Deb_Fle "J" "MC" "H" 1.0 Pt_Deb_Fle MText "") ;; ;; ;;;Défini les quatre coins du MText de (gile) (princ "\nDéfini les quatre coins du MText de (gile)") (setq MTxt (entlast)) (setq elst (entget (entlast))) (if (= "MTEXT" (cdr (assoc 0 (entget (entlast))))) (setq nor (cdr (assoc 210 elst)) ref (trans (cdr (assoc 10 elst)) 0 nor) rot (angle '(0 0 0) (trans (cdr (assoc 11 elst)) 0 nor)) wid (cdr (assoc 42 elst)) hgt (cdr (assoc 43 elst)) jus (cdr (assoc 71 elst)) org (list (cond ((member jus '(2 5 8)) (/ wid -2)) ((member jus '(3 6 9)) (- wid)) (T 0.0) ) ;_ Fin de cond (cond ((member jus '(1 2 3)) (- hgt)) ((member jus '(4 5 6)) (/ hgt -2)) (T 0.0) ) ;_ Fin de cond ) ;_ Fin de list plst (mapcar (function (lambda (p) (mapcar '+ org p))) (list (list (- 0.1) (- 0.1)) (list (+ wid 0.1) (- 0.1)) (list (+ wid 0.1) (+ hgt 0.1)) (list (- 0.1) (+ hgt 0.1)) ) ;_ Fin de list ) ;_ Fin de mapcar ) ;_ Fin de setq (setq box (textbox elst) ref (cdr (assoc 10 elst)) rot (cdr (assoc 50 elst)) plst (list (list (- (caar box) 0.1) (- (cadar box) 0.1)) (list (+ (caadr box) 0.1) (- (cadar box) 0.1)) (list (+ (caadr box) 0.1) (+ (cadadr box) 0.1)) (list (- (caar box) 0.1) (+ (cadadr box) 0.1)) ) ;_ Fin de list ) ;_ Fin de setq ) ;_ Fin de if (setq mat (list (list (cos rot) (- (sin rot)) 0) (list (sin rot) (cos rot) 0) '(0 0 1)) ;_ Fin de list plst (mapcar (function (lambda (p) (mapcar '+ (mxv mat p) (list (car ref) (cadr ref)))) ;_ Fin de lambda ) ;_ Fin de function plst ) ;_ Fin de mapcar ) ;_ Fin de setq (setq Pt1 (list (car (nth 0 plst)) (cadr (nth 0 plst)))) (setq Pt2 (list (car (nth 1 plst)) (cadr (nth 1 plst)))) (setq Pt3 (list (car (nth 2 plst)) (cadr (nth 2 plst)))) (setq Pt4 (list (car (nth 3 plst)) (cadr (nth 3 plst)))) (setvar "osmode" 0) ;; (princ "\nDébut calcul flèche") (setq p3 (polar Pt_Deb_Fle (angle Pt_Deb_Fle Pt1) Long)) (princ "\nDébut Flèche") ;(command "_.pline" Pt_Deb_Fle "_w" 0 Larg p3 "_w" 0 0 Pt_Fin_Fle "") (princ "\nDébut Cadre") (command "_.pline" Pt1 Pt2 Pt3 Pt4 Pt1 "") ;_ Fin de command ;;; paramètres de la flèche (setq Long 2 ;; Longueur de la tête de la flèche Larg 1 ;; Largeur de du pied de la flèche Pt_Deb_Fle (getpoint "\nPointe de la petite flèche : ") Pt_Fin_Fle (getpoint Pt_Deb_Fle "\nPied de la flèche : ") Pt_Pied_Fle (polar Pt_Deb_Fle (angle Pt_Deb_Fle Pt_Fin_Fle) Long) ) ;_ Fin de setq (command "_.pline" Pt_Deb_Fle "_w" 0 Larg Pt_Pied_Fle "_w" 0 0 Pt_Fin_Fle "") (vlax-ldata-put "DenisH" "ValIncrement" (+ ValIncrement 1)) (setq ValIncrement (vlax-ldata-get "DenisH" "ValIncrement")) ) ;_ Fin de defun ;;; Active le début de l'undo (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (setq old_cmdecho (getvar "cmdecho") old_osmode (getvar "osmode") ) ;_ Fin de setq (command "-calque" "e" "MARTY-SURFACES_FRACTIONS" "co" "u" "255,0,255" "MARTY-SURFACES_FRACTIONS" "") ;_ Fin de command (setq PrefixIncrement (vlax-ldata-get "DenisH" "PrefixIncrement" "VarB")) (if (= PrefixIncrement nil) (vlax-ldata-put "DenisH" "PrefixIncrement" "VarB") ) ;_ Fin de if (setq ValIncrement (vlax-ldata-get "DenisH" "ValIncrement" 0)) (if (or (= ValIncrement "") (= ValIncrement nil)) (progn (vlax-ldata-put "DenisH" "ValIncrement" 0) (setq ValIncrement (vlax-ldata-get "DenisH" "ValIncrement")) ) ;_ Fin de progn ) ;_ Fin de if (if (not (tblsearch "style" "Surface")) (command "-style" "Surface" "arial.ttf" "" "" "" "" "" "") ) ;_ Fin de if (command "textstyle" "Surface") (while (/= (type Option1) 'LIST) (initget "Préfix Nombre Suivant") (setq Option1 (getkword (strcat "\nOptions des textes [Préfix/Nombre/Suivant] <" PrefixIncrement (itoa ValIncrement) "> : ") ;_ Fin de strcat ) ;_ Fin de getkword ) ;_ Fin de setq (cond ((= Option1 "Préfix") (setq PrefixIncrement (getstring (strcat "\nSaisir le préfix de l'incrémentation <" PrefixIncrement "> : ")) ;_ Fin de getstring ) ;_ Fin de setq (vlax-ldata-put "DenisH" "PrefixIncrement" PrefixIncrement) ) ((= Option1 "Nombre") (setq ValIncrement (getint "\nSaisir le prochain numéro de l'incrémentation : ")) ;_ Fin de getstring (if (or (= ValIncrement "") (= ValIncrement nil)) (vlax-ldata-put "DenisH" "ValIncrement" 0) (vlax-ldata-put "DenisH" "ValIncrement" ValIncrement) ) ;_ Fin de if ) ((= Option1 "Suivant") (initget "Contour Polyligne") (setq Option2 (getkword "\nOptions des textes [Contour/Polyligne] <Contour> : ") ;_ Fin de strcat ) ;_ Fin de getkword (cond ((or (= Option2 "Contour") (= Option2 nil)) ;_ Fin de or (while (princ "\nChoisir le contour :") (command "-contour" "O" "O" "P" "" pause "") (EcritText)) ) ((= Option2 "Polyligne") (while (princ "\nSaisisser le contour :") (command "_.pline" (while (not (zerop (getvar "cmdactive"))) (command pause)) ;_ Fin de while ) ;_ Fin de command (EcritText) ) ;_ Fin de while ) ) ;_ Fin de cond ) ) ;_ Fin de cond ) ;_ Fin de while (setvar "osmode" old_osmode) (setvar "cmdecho" old_cmdecho) (setvar "plinewid" 0) ;;; Fin de l'undo (vla-endundomark doc) (princ) ) ;_ Fin de defun
  25. Alors j'ai la même erreur clayer que précédemment et j'ai que la première ligne soulignée, pas de cadre autour du texte.
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité