Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Contour avec texte surface

Hydro8

Par Hydro8
dans Débuter en LISP

 Partager

Messages recommandés

DenisHen Proficient

DenisHen

Posté(e)
Posté(e)

Normalement, ton texte devrait être en style "Surface"...

As-tu ce style de texte ?

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

  • Réponses 206
  • Créé
  • Dernière réponse

Meilleurs contributeurs dans ce sujet

Jours populaires

Meilleurs contributeurs dans ce sujet

Jours populaires

Images postées

DenisHen Proficient

DenisHen

Posté(e)
Posté(e)

Je t'ai réécris quelques lignes changé d'autre et modifié certaines.

 

Normalement, c'est Ok, mais le texte se retrouve encadré, plus facile pour dessiné un trait de rappel... :

;;; ***********************************************************
;;; 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
   (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

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

Hydro8 Apprentice

Hydro8

Posté(e)
  • Auteur
Posté(e)

Merci pour ton aide encore une fois.

 

Alors j'ai copié ton code dans mon ancien lisp laissant les xdata de gile et le code pour l'export des xdata.

 

Quand je clique sur un endroit pour le texte il apparait bien, la première ligne est soulignée cependant je n'ai pas de trait de rappel et à aucun moment il m'a demandé le début et la fin de la flèche comme le code d'avant.

DenisHen Proficient

DenisHen

Posté(e)
Posté(e)

cependant je n'ai pas de trait de rappel et à aucun moment il m'a demandé le début et la fin de la flèche comme le code d'avant.

Je l'ai enlevé, mais je peux l'ajouter à la fin du code...

 

Est-ce que le texte est bien encadré ?

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

DenisHen Proficient

DenisHen

Posté(e)
Posté(e)

Tu peux ajouter ça :

;;; 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 "")

Juste après la ligne :

    (command "_.pline" Pt1 Pt2 Pt3 Pt4 Pt1 "") ;_ Fin de command

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

DenisHen Proficient

DenisHen

Posté(e)
Posté(e)

Je n'arrive pas à m'expliqué l'erreur de clayer.

 

C'est volontairement que je n'ai souligné que la première ligne.

 

Au temps pour moi, place cette ligne :

(command "_.pline" Pt1 Pt2 Pt3 Pt4 Pt1 "")

Juste avant les lignes des paramètres de la flèche :

;;; 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

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

DenisHen Proficient

DenisHen

Posté(e)
Posté(e)

Peut-être un truc... Remplace :

  (command "-calque" "e" "MARTY-SURFACES_FRACTIONS" "co" "u" "255,0,255" "MARTY-SURFACES_FRACTIONS" "")

 

Par ces lignes :

  (setvar "clayer" "0")
 (if (not (tblsearch "layer" "MARTY-SURFACES_FRACTIONS"))
   (command "-calque" "e" "MARTY-SURFACES_FRACTIONS" "co" "u" "255,0,255" "MARTY-SURFACES_FRACTIONS" "")
   (command "-calque" "ch" "MARTY-SURFACES_FRACTIONS" "")
 ) ;_ Fin de if

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

Hydro8 Apprentice

Hydro8

Posté(e)
  • Auteur
Posté(e)

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

DenisHen Proficient

DenisHen

Posté(e)
Posté(e)

Salut.

 

Pour la flèche, remplace tous ce qui existe entre ça :

    (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)

Et ça :

    (vlax-ldata-put "DenisH" "ValIncrement" (+ ValIncrement 1))
   (setq ValIncrement (vlax-ldata-get "DenisH" "ValIncrement"))

Par ça :

    ;;
   (command "_.pline" Pt1 Pt2 Pt3 Pt4 Pt1 "") ;_ Fin de command
;;; paramètres de la flèche
   (princ "\nDébut calcul 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 "")

Ça devrait résoudre le problème de la flèche, je pense aussi à une confusion dans les copier/coller.

 

Pour le soulignement, c'est volontaire de ne souligner que la première ligne du texte. Si tu veux tout souligner, déplace le "\\l" à la fin, comme ça :

(setq MText (strcat "\\H1.2\\L" PrefixIncrement (itoa ValIncrement) "\\P\\H1S=" xSurf "m²\\P" Opt3 "\\l"))

 

Ou supprime-le carrément...

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

Hydro8 Apprentice

Hydro8

Posté(e)
  • Auteur
Posté(e)

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 :

 

Défini les quatre coins du MText de (gile)paramètre de la variable AutoCAD rejeté: "clayer" nil

 

À priori en relation avec la définition de la flêche.

DenisHen Proficient

DenisHen

Posté(e)
Posté(e)

Ce doit être encore un problème la variable "clayer" (Curent Layer).

 

Je ne comprend rien, je n'ai aucun problème chez moi...

 

Peux-tu m'envoyer ton dwg ?

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

DenisHen Proficient

DenisHen

Posté(e)
Posté(e)

Je ne comprend plus rien. Mon code fonctionne parfaitement chez moi, même avec ton fichier...

 

Voici la dernière version : 

;;; ***********************************************************
;;; 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 "")
   ;;
   ;;
;;;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 Pt3 Pt4 Pt1 "") ;_ Fin de command
;;; paramètres de la flèche
   (princ "\nDébut calcul 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
;_ 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

 

Après, ça dépasse mes humbles compétences...

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

Hydro8 Apprentice

Hydro8

Posté(e)
  • Auteur
Posté(e)

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 ?

DenisHen Proficient

DenisHen

Posté(e)
Posté(e)

Ben justement, il n'y a rien dans la création des flèches qui le laisse penser...

 

Essaye avec ce fichier.

 

Ou copie cette nouvelle commande dans ton fichier .lsp, recharge-le et tape "DH_Fleche" dans AutoCAD :

;;; *******************
;;; Dessine une flèche 
;;; *******************
(defun c:DH_Fleche ()
 ;;; paramètres de la flèche
   (princ "\nDébut calcul 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 "")
 )

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

Hydro8 Apprentice

Hydro8

Posté(e)
  • Auteur
Posté(e)

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.

Hydro8 Apprentice

Hydro8

Posté(e)
  • Auteur
Posté(e)

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

DenisHen Proficient

DenisHen

Posté(e)
Posté(e)

C'est dommage de ne pas automatiser l'encadrement du texte...

 

Du coup, après ;

(command "_.-MTEXT" Pt_Deb_Fle "J" "MC" "H" 1.0 Pt_Deb_Fle MText "")

 

Tu peux ajouter :

(c:DH_Fleche)

Windows 11 / AutoCAD 2024

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).
Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)

lecrabe Mentor

lecrabe

Posté(e)
Posté(e)

Hello

 

SVP je n'ai pas la fonction MXV ?

 

Merci, Bye, lecrabe

 

PS: ... (mxv mat p) ...

 

(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

Autodesk Expert Elite Team

Hydro8 Apprentice

Hydro8

Posté(e)
  • Auteur
Posté(e)

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.

lecrabe Mentor

lecrabe

Posté(e)
Posté(e)

Hello

 

Il a fallu que le vieux Diplodocus vienne s'interesser a cette routine Sympa !

 

Vous voyez les vieux cela peut parfois servir a qq chose !?

 

Bon WE, Bye, lecrabe

Autodesk Expert Elite Team

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets


×
×
  • 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é