personnalisation des hachures

[zebulon_]

Bonjour,

 

Je dois dessiner des murs Terre Armée (rien à voir avec l'Armée de Terre)

 

http://www.groupetai.com/intranet/internetTA.nsf/Web/indexfr.htm

 

murs constitués d'écailles béton préfabriqué en forme de + qui s'emboîtent les uns dans les autres. Donc, je me suis dis, là il faut faire un motif de hachurage.

 

Je me suis gratté la tête un moment avant de comprendre comment on définissait des motifs de hachurage, mais j'y suis quand même arrivé.

 

ça donne quelque chose de ce goût là.

 

*TA,Terre Armee
0, 0.125,0, 0,1.500, 1.375,-1.625
0, 1.625,0.750, 0,1.500, 1.375,-1.625
0, 0,0.375, 0,0.750, 0.125,-1.375
90, 0,0.375, 0,3.000, 0.75,-0.75
90, 1.625,0.375, 0,3.000, 0.75,-0.75
90, 0.125,-0.375, 0,3.000, 0.75,-0.75
90, 1.500,-0.375, 0,3.000, 0.75,-0.75

 

J'ai rajouté cette définition à la fin de acadiso.pat et ça marche bien.

 

J'ai extrait cette définition de hachure du fichier standart pour le coller dans un fichier perso.pat que j'ai mis dans un répertoire listé dans les repertoires des fichiers de support.

 

Quand je fais une hachure, je choisis un type personnalisation. Puis, au niveau de Personnaliser Motif, je pioche le fichier perso.pat. Et là, je me fais engueuler par Autocad : Erreur dans le fichier de Motifs. :casstet:

 

Pour tester, j'ai copié le fichier acadiso.pat dans le même répertoire que perso.pat et je l'ai renommé mypat.pat. Il ne devrait pas y avoir d'erreur sur ce fichier quand même... Mais, même punition.

 

Si quelqu'un sait comment on peut mettre des hachure personnalisées dans un fichier autre que AutoCAD.pat ou acadiso.pat et pouvoir s'en servir ?

 

Merci

 

Amicalement

 

Zebulon_

 

[Edité le 28/10/2005 par zebulon_]

[kallain]

Salut,

 

J'ai recopié ton fichier dans C:mes routines en le nommant : ta.pat

 

Ca marche au poil :D

 

PS : C'est balèze de créer un type de hachure : Bravo ;)

[kallain]

un répertoire listé dans les repertoires des fichiers de support.

 

Chez moi le répertoire "mes routines" est aussi dans

Chemin de recherche des fichiers de support [surligneur] en cours d'utilisation[/surligneur]

Bon week-end , à mercredi.

[archidaniel]

Bonjour

Ton fichier personnalise de hachures TA doit s'appeler "TA.PAT" et se trouver sur un chemin de recherche d'autocad.

Vérifie également qu'il y a bien un retour chariot (ENTER = fin de ligne) à la dernière ligne de ton fichier.

A+

Daniel Gillard

[(gile)]

Salut,

 

Pour créer de hachures personnalisées,il y a un utilitaire (LISP) ici qui marche plutôt bien !

[zebulon_]

Ton fichier personnalise de hachures TA doit s'appeler "TA.PAT"

Effectivement, ça marche mieux. Je pensais que je pouvais créer une fichier perso.pat qui contient une collection de hachures, comme pour acadiso.pat. Grossière erreur, une hachure perso par fichier pat et avec correspondance du nom du fichier et de la hachure, sinon on à droit à l'engueulade.

 

 

 

 

PS : C'est balèze de créer un type de hachure : Bravo

Le moins qu'on puisse dire c'est que l'aide n'est pas très fournie pour la création de hachures. Si je n'avais pas trouvé une explication un peu plus détaillée dans le vieux manuel de personnalisation de la version 12 (ma pierre de rosette, en gros), je crois que je n'y serais jamais arrivé.

 

 

 

Pour créer de hachures personnalisées,il y a un utilitaire (LISP) ici qui marche plutôt bien !

Il marche pas mal, mais le fichier .pat produit par le lisp et nettement plus compliqué que les 7 lignes que j'ai pondues. D'autre part, mon modèle n'est pas carré, donc je n'arrive pas à le faire rentrer dans le carré 1x1 proposé par le lisp. Pour finir, comme on est limité à un carré 1x1 et que mon modèle est plus grand (env. 1.65x1.50), il faudra bricoler avec des facteurs d'échelle à la création de la hachure.

 

Merci

 

Amicalement

 

Zebulon_

 

 

[Invité Sylvainhinard]

Bonjour Gilles,

 

Tout d'abord merci à toi. J'ai trouvé ce Lisp sur internet qui n'était pas au point et je savais que je trouverai quelqu'un qui reussirai à le corriger. J'aurai un second service à te demander : peux tu me donner la démarche à suivre pour créer un PAT avec ce LISP. J'ai reussis à faire un fichier PAT dans le carré de 1m mais Autocad me le dessine sans dessus dessous.

 

Merci

 

Sylvain

[(gile)]

Salut,

 

Je ne comprends pas bien ta demande, alors je décortique toute la démarche à suivre avec ce LISP :

 

Pour créer le motif, taper DRAWHATCH à la ligne de commande. Le LISP crée l'environnement nécessaire au bon fonctionnement de la suite, à savoir : RESOL activé et paramétré à 0.01X0.01 et un carré de 1X1 dans lequel il faut dessiner le motif de hachures uniquement avec des lignes et des points.

 

Pour enregistrer le motif, taper SAVEHATCH à la ligne de commande, faire "ENTER" comme demandé dans la fenêtre d'AutoCAD, sélectioner le motif (seuls les lignes et points seront sélectionnés), décrire le motif ou faire "ENTER", enregistrer le motif (sous"hachure_perso_1" par exemple) dans un dossier du chemin de recherche d'AutoCAD.

 

Si l'opération est réussie, on lit sur la ligne de commande :

"Attendez que le fichier de hachures soit créé SVP..."

puis :

"Le motif de hachures 'hachure_perso_1' est prêt pour l'utilisation !"

 

Si tu as un dossier spécial pour tes hachures personnalisées dont tu as indiqué le chemin dans les chemins de recherche des fichiers de support (par exemple "C:\Mes_perso\Mes_hachures") tu peux remplacer la ligne surlignée dans le LISP ( "I:\\Acad\\Hatch\\") par ""C:\\Mes_perso\\Mes_hachures\\".

 

J'espère avoir répondu à ta demande.

[rebcao]

Hello Gilles, 

Le lien vers le LISP ne fonctionne plus ?! aurais-tu un autre lien ?

Merci.

Christian

[PHILPHIL]

hello Rebcao

 

voici le lisp

la deuxieme version que j'ai modifie doit etre pour bosser en cm ou avoir un carre plus grand .

j'ai testé une seule fois

 

Phil
 

;;;CADALYST 10/05 Tip 2065: HatchMaker.lsp Hatch Maker (c) 2005 Larry Schiele

;;;* ====== B E G I N C O D E N O W ======
;;;* HatchMaker.lsp written by Lanny Schiele at TMI Systems Design Corporation
;;;* Lanny.Schiele@tmisystems.com
;;;* Tested on AutoCAD 2002 & 2006. -- does include a 'VL' function -- should work on Acad2000 on up.

;;; Traduction littérale et approximative des invites en français : Gile
;;;   c:drawhatch  remplacer par c:hatchdraw
;;;   c:savehatch  remplacer par c:hatchsave


(defun c:hatchdraw (/)
  (command "_undo" "_begin")
  (setq os (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (command "_ucs" "_w")
  (command "_pline" "0,0" "0,1" "1,1" "1,0" "_c")
  (command "_zoom" "_c" "0.5,0.5" 1.1)
  (setvar "OSMODE" os)
  (setvar "SNAPMODE" 1)
  (setvar "SNAPUNIT" (list 0.01 0.01))
  (command "_undo" "_end")
  (alert
    "Dessiner le modèle dans un carré de 1x1 \nen utilisant uniquement des POINTS et des LIGNES..."
  )
  (princ)
)

(defun c:hatchsave (/        round    dxf      listtofile        user     selset   selsetsize        ssnth    ent
                    entinfo  enttype  pt1      pt2      dist     angto    angfrom  xdir     ydir     gap      deltax
                    deltay   angzone  counter  ratio    factor   hatchname         hatchdescr        filelines
                    filelines         filename scaler   scaledx  scaledy  rf       x        y        h        _ab
                    _bc      _ac      _ad      _de      _ef      _eh      _fh      dimzin
                   )
;;;* BEGIN NESTED FUNCTIONS
  (defun round (num)
    (if (>= (- num (fix num)) 0.5)
      (fix (1+ num))
      (fix num)
    )
  )
  (defun dxf (code enameorelist / vartype)
    (setq vartype (type enameorelist))
    (if (= vartype (read "ENAME"))
      (cdr (assoc code (entget enameorelist)))
      (cdr (assoc code enameorelist))
    )
  )
  (defun listtofile (textlist filename doopenwithnotepad asappend / textitem file retval)
    (if (setq file (open filename
                         (if asappend
                           "a"
                           "w"
                         )
                   )
        )
      (progn (foreach textitem textlist (write-line textitem file))
             (setq file (close file))
             (if doopenwithnotepad
               (startapp "notepad" filename)
             )
      )
    )
    (findfile filename)
  )
;;;* END NESTED FUNCTIONS
  (princ
    (strcat "\n."                                           "\n 0,1 ----------- 1,1"
            "\n |                | "                        "\n | Lignes et      | "
            "\n | points doivent | "                        "\n | être accrochés | "
            "\n | au plus proche | "                        "\n | 0.01           | "
            "\n |                | "                        "\n 0,0 ----------- 1,0"
            "\n."
            "\nNota: Les lignes doivent être dessinées entre 0,0 et 1,1 et sur une grille de 0.01."
           )
  )
  (textscr)
  (getstring "\nTaper [ENTER] pour continuer...")
  (princ
    "\nSelectionnez un modèle de 1x1 constitué de lignes et/ou de points pour un  nouveau motif de hachures..."
  )
  (while (not (setq selset (ssget (list (cons 0 "LINE,POINT"))))))
  (setq ssnth      0
        selsetsize (sslength selset)
        dimzin     (getvar "DIMZIN")
  )
  (setvar "DIMZIN" 11)
  (if (> selsetsize 0)
    (princ "\nAnalyse des entités...")
  )
  (while (< ssnth selsetsize)
    (setq ent     (ssname selset ssnth)
          entinfo (entget ent)
          enttype (dxf 0 entinfo)
          ssnth   (+ ssnth 1)
    )
    (cond ((= enttype "POINT")
           (setq pt1      (dxf 10 entinfo)
                 fileline (strcat "0," (rtos (car pt1) 2 6) "," (rtos (cadr pt1) 2 6) ",0,1,0,-1")
           )
           (princ (strcat "\n" fileline))
           (setq filelines (cons fileline filelines))
          )
          ((= enttype "LINE")
           (setq pt1     (dxf 10 entinfo)
                 pt2     (dxf 11 entinfo)
                 dist    (distance pt1 pt2)
                 angto   (angle pt1 pt2)
                 angfrom (angle pt2 pt1)
                 isvalid nil
           )
           (if (or (equal (car pt1) (car pt2) 0.0001) (equal (cadr pt1) (cadr pt2) 0.0001))
             (setq deltax  0
                   deltay  1
                   gap     (- dist 1)
                   isvalid t
             )
             (progn (setq ang     (if (< angto pi)
                                    angto
                                    angfrom
                                  )
                          angzone (fix (/ ang (/ pi 4)))
                          xdir    (abs (- (car pt2) (car pt1)))
                          ydir    (abs (- (cadr pt2) (cadr pt1)))
                          factor  1
                          rf      1
                    )
                    (cond ((= angzone 0)
                           (setq deltay (abs (sin ang))
                                 deltax (abs (- (abs (/ 1.0 (sin ang))) (abs (cos ang))))
                           )
                          )
                          ((= angzone 1)
                           (setq deltay (abs (cos ang))
                                 deltax (abs (sin ang))
                           )
                          )
                          ((= angzone 2)
                           (setq deltay (abs (cos ang))
                                 deltax (abs (- (abs (/ 1.0 (cos ang))) (abs (sin ang))))
                           )
                          )
                          ((= angzone 3)
                           (setq deltay (abs (sin ang))
                                 deltax (abs (cos ang))
                           )
                          )
                    )
                    (if (not (equal xdir ydir 0.001))
                      (progn (setq ratio  (if (< xdir ydir)
                                            (/ ydir xdir)
                                            (/ xdir ydir)
                                          )
                                   rf     (* ratio factor)
                                   scaler (/ 1
                                             (if (< xdir ydir)
                                               xdir
                                               ydir
                                             )
                                          )
                             )
                             (if (not (equal ratio (round ratio) 0.001))
                               (progn (while (and (<= factor 100) (not (equal rf (round rf) 0.001)))
                                        (setq factor (+ factor 1)
                                              rf     (* ratio factor)
                                        )
                                      )
                                      (if (and (> factor 1) (<= factor 100))
                                        (progn (setq _ab (* xdir scaler factor)
                                                     _bc (* ydir scaler factor)
                                                     _ac (sqrt (+ (* _ab _ab) (* _bc _bc)))
                                                     _ef 1
                                                     x   1
                                               )
                                               (while (< x (- _ab 0.5))
                                                 (setq y (* x (/ ydir xdir))
                                                       h (if (< ang (/ pi 2))
                                                           (- (+ 1 (fix y)) y)
                                                           (- y (fix y))
                                                         )
                                                 )
                                                 (if (< h _ef)
                                                   (setq _ad x
                                                         _de y
                                                         _ae (sqrt (+ (* x x) (* y y)))
                                                         _ef h
                                                   )
                                                 )
                                                 (setq x (+ x 1))
                                               )
                                               (if (< _ef 1)
                                                 (setq _eh     (/ (* _bc _ef) _ac)
                                                       _fh     (/ (* _ab _ef) _ac)
                                                       deltax  (+ _ae
                                                                  (if (> ang (/ pi 2))
                                                                    (- _eh)
                                                                    _eh
                                                                  )
                                                               )
                                                       deltay  (+ _fh)
                                                       gap     (- dist _ac)
                                                       isvalid t
                                                 )
                                               )
                                        )
                                      )
                               )
                             )
                      )
                    )
                    (if (= factor 1)
                      (setq gap     (- dist (abs (* factor (/ 1 deltay))))
                            isvalid t
                      )
                    )
             )
           )
           (if isvalid
             (progn (setq fileline (strcat (angtos angto 0 6)
                                           ","
                                           (rtos (car pt1) 2 8)
                                           ","
                                           (rtos (cadr pt1) 2 8)
                                           ","
                                           (rtos deltax 2 8)
                                           ","
                                           (rtos deltay 2 8)
                                           ","
                                           (rtos dist 2 8)
                                           ","
                                           (rtos gap 2 8)
                                   )
                    )
                    (princ (strcat "\n" fileline))
                    (setq filelines (cons fileline filelines))
             )
             (princ
               (strcat "\n * * * Ligne avec angle non valide " (angtos angto 0 6) (chr 186) " proscrit. * * *")
             )
           )
          )
          ((princ (strcat "\n * * * Entite non valide " enttype " proscrit(e).")))
    )
  )
  (setvar "DIMZIN" dimzin)
  (if (and filelines
           (setq hatchdescr (getstring t "\nDécrivez brièvement ce motif de hachures: "))
           (setq filename (getfiled "Fichier de hachures"
                                    "c:\\perso\\hachure\\hachure phil\\"
 ; Chemin du dossier des hachures personnalisées[/surligneur]
                                    "pat"
                                    1
                          )
           )
      )
    (progn (if (= hatchdescr "")
             (setq hatchdescr "Modèle de hachures personnalisé")
           )
           (setq hatchname (vl-filename-base filename)
                 filelines (cons (strcat "*" hatchname "," hatchdescr) (reverse filelines))
           )
           (princ "\n============================================================")
           (princ (strcat "\nAttendez que le fichier de hachures soit créé SVP...\n"))
           (listtofile filelines filename nil nil)
           (command "_delay" 1500) ; Délai requis pour que le fichier soit créé et trouvé (stupide, mais requis)
           (if (findfile filename)
             (progn (setvar "HPNAME" hatchname)
                    (princ (strcat "\nLe motif de hachures '" hatchname "' est prêt pour l'utilisation !"))
             )
             (progn (princ "\nImpossible de créer le fichier de hachures:") (princ (strcat "\n " filename)))
           )
    )
    (princ (if filelines
             "\nAbandon."
             "\nImpossible de créer le motif de hachures avec les entités sélectionnées."
           )
    )
  )
  (princ)
)

(princ "\n ************************************************************** ")
(princ "\n** **")
(princ "\n* HatchMaker.lsp written by Lanny Schiele -- enjoy! *")
(princ "\n* *")
(princ "\n* Taper DRAWHATCH pour avoir l'environment de dessin. *")
(princ "\n* Taper SAVEHATCH pour enregistrer le motif créé. *")
(princ "\n** **")
(princ "\n ************************************************************** ")
(princ)



;;;* ====== B E G I N C O D E N O W ======
;;;* HatchMaker.lsp written by Lanny Schiele at TMI Systems Design Corporation
;;;* Lanny.Schiele@tmisystems.com
;;;* Tested on AutoCAD 2002 & 2006. -- does include a 'VL' function -- should work on Acad2000 on up.

;;; Traduction littérale et approximative des invites en français : Gile
;;;   c:drawhatch  remplacer par c:hatchdraw
;;;   c:savehatch  remplacer par c:hatchsave


(defun c:hatchdraw2 (/)
  (command "_undo" "_begin")
  (setq os (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (command "_ucs" "_w")
  (command "_pline" "0,0" "0,100" "100,100" "100,0" "_c")
  (command "_zoom" "_c" "0.5,0.5" 1.1)
  (setvar "OSMODE" os)
  (setvar "SNAPMODE" 1)
  (setvar "SNAPUNIT" (list 0.01 0.01))
  (command "_undo" "_end")
  (alert
    "Dessiner le modèle dans un carré de 1x1 \nen utilisant uniquement des POINTS et des LIGNES..."
  )
  (princ)
)

(defun c:hatchsave2 (/        round    dxf      listtofile        user     selset   selsetsize        ssnth    ent
                     entinfo  enttype  pt1      pt2      dist     angto    angfrom  xdir     ydir     gap      deltax
                     deltay   angzone  counter  ratio    factor   hatchname         hatchdescr        filelines
                     filelines         filename scaler   scaledx  scaledy  rf       x        y        h        _ab
                     _bc      _ac      _ad      _de      _ef      _eh      _fh      dimzin
                    )
;;;* BEGIN NESTED FUNCTIONS
  (defun round (num)
    (if (>= (- num (fix num)) 0.5)
      (fix (1+ num))
      (fix num)
    )
  )
  (defun dxf (code enameorelist / vartype)
    (setq vartype (type enameorelist))
    (if (= vartype (read "ENAME"))
      (cdr (assoc code (entget enameorelist)))
      (cdr (assoc code enameorelist))
    )
  )
  (defun listtofile (textlist filename doopenwithnotepad asappend / textitem file retval)
    (if (setq file (open filename
                         (if asappend
                           "a"
                           "w"
                         )
                   )
        )
      (progn (foreach textitem textlist (write-line textitem file))
             (setq file (close file))
             (if doopenwithnotepad
               (startapp "notepad" filename)
             )
      )
    )
    (findfile filename)
  )
;;;* END NESTED FUNCTIONS
  (princ
    (strcat "\n."                                           "\n 0,1 ----------- 1,1"
            "\n |                | "                        "\n | Lignes et      | "
            "\n | points doivent | "                        "\n | être accrochés | "
            "\n | au plus proche | "                        "\n | 0.01           | "
            "\n |                | "                        "\n 0,0 ----------- 1,0"
            "\n."
            "\nNota: Les lignes doivent être dessinées entre 0,0 et 1,1 et sur une grille de 0.01."
           )
  )
  (textscr)
  (getstring "\nTaper [ENTER] pour continuer...")
  (princ
    "\nSelectionnez un modèle de 1x1 constitué de lignes et/ou de points pour un  nouveau motif de hachures..."
  )
  (while (not (setq selset (ssget (list (cons 0 "LINE,POINT"))))))
  (setq ssnth      0
        selsetsize (sslength selset)
        dimzin     (getvar "DIMZIN")
  )
  (setvar "DIMZIN" 11)
  (if (> selsetsize 0)
    (princ "\nAnalyse des entités...")
  )
  (while (< ssnth selsetsize)
    (setq ent     (ssname selset ssnth)
          entinfo (entget ent)
          enttype (dxf 0 entinfo)
          ssnth   (+ ssnth 1)
    )
    (cond ((= enttype "POINT")
           (setq pt1      (dxf 10 entinfo)
                 fileline (strcat "0," (rtos (car pt1) 2 6) "," (rtos (cadr pt1) 2 6) ",0,1,0,-1")
           )
           (princ (strcat "\n" fileline))
           (setq filelines (cons fileline filelines))
          )
          ((= enttype "LINE")
           (setq pt1     (dxf 10 entinfo)
                 pt2     (dxf 11 entinfo)
                 dist    (distance pt1 pt2)
                 angto   (angle pt1 pt2)
                 angfrom (angle pt2 pt1)
                 isvalid nil
           )
           (if (or (equal (car pt1) (car pt2) 0.0001) (equal (cadr pt1) (cadr pt2) 0.0001))
             (setq deltax  0
                   deltay  1
                   gap     (- dist 1)
                   isvalid t
             )
             (progn (setq ang     (if (< angto pi)
                                    angto
                                    angfrom
                                  )
                          angzone (fix (/ ang (/ pi 4)))
                          xdir    (abs (- (car pt2) (car pt1)))
                          ydir    (abs (- (cadr pt2) (cadr pt1)))
                          factor  1
                          rf      1
                    )
                    (cond ((= angzone 0)
                           (setq deltay (abs (sin ang))
                                 deltax (abs (- (abs (/ 1.0 (sin ang))) (abs (cos ang))))
                           )
                          )
                          ((= angzone 1)
                           (setq deltay (abs (cos ang))
                                 deltax (abs (sin ang))
                           )
                          )
                          ((= angzone 2)
                           (setq deltay (abs (cos ang))
                                 deltax (abs (- (abs (/ 1.0 (cos ang))) (abs (sin ang))))
                           )
                          )
                          ((= angzone 3)
                           (setq deltay (abs (sin ang))
                                 deltax (abs (cos ang))
                           )
                          )
                    )
                    (if (not (equal xdir ydir 0.001))
                      (progn (setq ratio  (if (< xdir ydir)
                                            (/ ydir xdir)
                                            (/ xdir ydir)
                                          )
                                   rf     (* ratio factor)
                                   scaler (/ 1
                                             (if (< xdir ydir)
                                               xdir
                                               ydir
                                             )
                                          )
                             )
                             (if (not (equal ratio (round ratio) 0.001))
                               (progn (while (and (<= factor 100) (not (equal rf (round rf) 0.001)))
                                        (setq factor (+ factor 1)
                                              rf     (* ratio factor)
                                        )
                                      )
                                      (if (and (> factor 1) (<= factor 100))
                                        (progn (setq _ab (* xdir scaler factor)
                                                     _bc (* ydir scaler factor)
                                                     _ac (sqrt (+ (* _ab _ab) (* _bc _bc)))
                                                     _ef 1
                                                     x   1
                                               )
                                               (while (< x (- _ab 0.5))
                                                 (setq y (* x (/ ydir xdir))
                                                       h (if (< ang (/ pi 2))
                                                           (- (+ 1 (fix y)) y)
                                                           (- y (fix y))
                                                         )
                                                 )
                                                 (if (< h _ef)
                                                   (setq _ad x
                                                         _de y
                                                         _ae (sqrt (+ (* x x) (* y y)))
                                                         _ef h
                                                   )
                                                 )
                                                 (setq x (+ x 1))
                                               )
                                               (if (< _ef 1)
                                                 (setq _eh     (/ (* _bc _ef) _ac)
                                                       _fh     (/ (* _ab _ef) _ac)
                                                       deltax  (+ _ae
                                                                  (if (> ang (/ pi 2))
                                                                    (- _eh)
                                                                    _eh
                                                                  )
                                                               )
                                                       deltay  (+ _fh)
                                                       gap     (- dist _ac)
                                                       isvalid t
                                                 )
                                               )
                                        )
                                      )
                               )
                             )
                      )
                    )
                    (if (= factor 1)
                      (setq gap     (- dist (abs (* factor (/ 1 deltay))))
                            isvalid t
                      )
                    )
             )
           )
           (if isvalid
             (progn (setq fileline (strcat (angtos angto 0 6)
                                           ","
                                           (rtos (car pt1) 2 8)
                                           ","
                                           (rtos (cadr pt1) 2 8)
                                           ","
                                           (rtos deltax 2 8)
                                           ","
                                           (rtos deltay 2 8)
                                           ","
                                           (rtos dist 2 8)
                                           ","
                                           (rtos gap 2 8)
                                   )
                    )
                    (princ (strcat "\n" fileline))
                    (setq filelines (cons fileline filelines))
             )
             (princ
               (strcat "\n * * * Ligne avec angle non valide " (angtos angto 0 6) (chr 186) " proscrit. * * *")
             )
           )
          )
          ((princ (strcat "\n * * * Entite non valide " enttype " proscrit(e).")))
    )
  )
  (setvar "DIMZIN" dimzin)
  (if (and filelines
           (setq hatchdescr (getstring t "\nDécrivez brièvement ce motif de hachures: "))
           (setq filename (getfiled "Fichier de hachures"
                                    "c:\\perso\\hachure\\hachure phil\\"
 ; Chemin du dossier des hachures personnalisées[/surligneur]
                                    "pat"
                                    1
                          )
           )
      )
    (progn (if (= hatchdescr "")
             (setq hatchdescr "Modèle de hachures personnalisé")
           )
           (setq hatchname (vl-filename-base filename)
                 filelines (cons (strcat "*" hatchname "," hatchdescr) (reverse filelines))
           )
           (princ "\n============================================================")
           (princ (strcat "\nAttendez que le fichier de hachures soit créé SVP...\n"))
           (listtofile filelines filename nil nil)
           (command "_delay" 1500) ; Délai requis pour que le fichier soit créé et trouvé (stupide, mais requis)
           (if (findfile filename)
             (progn (setvar "HPNAME" hatchname)
                    (princ (strcat "\nLe motif de hachures '" hatchname "' est prêt pour l'utilisation !"))
             )
             (progn (princ "\nImpossible de créer le fichier de hachures:") (princ (strcat "\n " filename)))
           )
    )
    (princ (if filelines
             "\nAbandon."
             "\nImpossible de créer le motif de hachures avec les entités sélectionnées."
           )
    )
  )
  (princ)
)

(princ "\n ************************************************************** ")
(princ "\n** **")
(princ "\n* HatchMaker.lsp written by Lanny Schiele -- enjoy! *")
(princ "\n* *")
(princ "\n* Taper DRAWHATCH pour avoir l'environment de dessin. *")
(princ "\n* Taper SAVEHATCH pour enregistrer le motif créé. *")
(princ "\n** **")
(princ "\n ************************************************************** ")
(princ)

 

[rebcao]

Hello Phil,

Je te remercie.

J'ai testé, ça fonctionne mais le motif obtenu n'est pas conforme à ce qui a été dessiné dans le carré de 1x1 ?!?!

A la fin du programme ce serait bien de changer le nom des commandes à taper... HATCHDRAW et HATCHSAVE

Je te remercie.

Christian