motif de hachures paramétrable

[kclement]

Bonjour,

 

J'ai trouvé ceci sur Cadalyst :

 

 ;;; CADALYST 03/08  www.cadalyst.com/code 
;;; Tip 2276: BRICKS.lsp	Brick Hatch Generator  (c) 2008 Raymond Rizkallah 

;;;=============================================================================
;;;          "BRICKS.LSP" : BRICKS HATCH PATTERN CREATOR
;;;;;; * Bricks patterns are created on the fly, with length, height & joint size of
;;;   your choice.;;; * Two different heights can be used.
;;; * Overlapping bricks is optional.
;;; * Afterwards, BHATCH command is invoked with the new pattern name as default.
;;;;;; "Your imagination is the limit" - Raymond Rizkallah - Nov./2007
;;;==============================================================================
(defun C:BRK ()
 (prompt " **Bricks, Tiles, & Stone Masonry Hatch Creator**")
 (if (null (numberp l1))
   (setq l1 15.0)
 )
 (if (null (numberp h1))
   (setq h1 5.0)
 )
 (if (null (numberp h2))
   (setq h2 3)
 )
 (if (null (numberp j1))
   (setq j1 0.5)
 )
 (setq	dir-name (findfile "acad.pat")
str-len	 (strlen dir-name)
 )
 (setq dir-name (substr dir-name 1 (- str-len 8)))
 (while
   (findfile
     (strcat dir-name
      (setq b-name (getstring "\n Brick pattern name to create: "))
      ".pat"
     )
   )
    (alert "\nPattern name already exist... Please try again. ")
 )
 (setq nl1 (getdist (strcat "\n Brick length <" (rtos l1) ">: ")))
 (setq nh1 (getdist (strcat "\n First height  <" (rtos h1) ">: ")))
 (setq nh2 (getdist (strcat "\n Second height <" (rtos h2) ">: ")))
 (setq nj1 (getdist (strcat "\n Joint size   <" (rtos j1) ">: ")))
 (initget "Yes No")
 (setq opt (getkword "\n Overlap bricks? [Yes/No] : "))
 (if (null opt)
   (setq opt "Yes")
 )
 (if nl1
   (setq l1 nl1)
 )
 (if nh1
   (setq h1 nh1)
 )
 (if nh2
   (setq h2 nh2)
 )
 (if nj1
   (setq j1 nj1)
 )
 (setq l1x (/ l1 2.0))
 (setq j1x (/ j1 2.0))
				;------------------- Overlapped -----------------------------------
 (setq	p-lst1 (list
;___ brick hatch pattern name (overlapped bricks)
	 (strcat "*"
		 b-name
		 ", "
		 "L="
		 (rtos l1 2 2)
		 " H1="
		 (rtos h1 2 2)
		 " H2="
		 (rtos h2 2 2)
		 " Jt="
		 (rtos j1 2 2)
		 " - Ovr."
	 ) ;___
;___ brick-1: line 1
	 (strcat "0,   "
		 "0,0,   "
		 "0,"
		 (rtos (+ h1 j1 h2 j1) 2 3)
		 ",   "
		 (rtos l1 2 3)
		 ",-"
		 (rtos j1 2 3)
	 )
;___ brick-1: line 2
	 (strcat "0,   "
		 "0,"
		 (rtos h1 2 3)
		 ",   "
		 "0,"
		 (rtos (+ h1 j1 h2 j1) 2 3)
		 ",   "
		 (rtos l1 2 3)
		 ",-"
		 (rtos j1 2 3)
	 )
;___ brick-1: line 3
	 (strcat "90,   "
		 "0,0,   "
		 "0,"
		 (rtos (+ l1 j1) 2 3)
		 ",   "
		 (rtos h1 2 3)
		 ",-"
		 (rtos (+ j1 h2 j1) 2 3)
	 )
;___ brick-1: line 4
	 (strcat "90,   "
		 (rtos l1 2 3)
		 ",0,   "
		 "0,"
		 (rtos (+ l1 j1) 2 3)
		 ",   "
		 (rtos h1 2 3)
		 ",-"
		 (rtos (+ j1 h2 j1) 2 3)
	 )
;___    ;___ brick-2: line 1
	 (strcat "0,   "
		 (rtos (+ l1x j1x) 2 3)
		 ","
		 (rtos (+ h1 j1) 2 3)
		 ",   "
		 "0,"
		 (rtos (+ h2 j1 h1 j1) 2 3)
		 ",   "
		 (rtos l1 2 3)
		 ",-"
		 (rtos j1 2 3)
	 )
;___ brick-2: line 2
	 (strcat "0,   "
		 (rtos (+ l1x j1x) 2 3)
		 ","
		 (rtos (+ h1 j1 h2) 2 3)
		 ",   "
		 "0,"
		 (rtos (+ h1 j1 h2 j1) 2 3)
		 ",   "
		 (rtos l1 2 3)
		 ",-"
		 (rtos j1 2 3)
	 )
;___ brick-2: line 3
	 (strcat "90,   "
		 (rtos (+ l1x j1x) 2 3)
		 ","
		 (rtos (+ h1 j1) 2 3)
		 ",   "
		 "0,"
		 (rtos (+ l1 j1) 2 3)
		 ",   "
		 (rtos h2 2 3)
		 ",-"
		 (rtos (+ j1 h1 j1) 2 3)
	 )
;___ brick-2: line 4
	 (strcat "90,   "
		 (rtos (+ l1x j1x l1) 2 3)
		 ","
		 (rtos (+ h1 j1) 2 3)
		 ",   "
		 "0,"
		 (rtos (+ l1 j1) 2 3)
		 ",   "
		 (rtos h2 2 3)
		 ",-"
		 (rtos (+ j1 h1 j1) 2 3)
	 )
       )
 )
				;end list/setq
				;------------------- Not Overlapped -------------------------------
 (setq	p-lst2 (list ;___ brick hatch pattern name (not overlapped)
	 (strcat "*"
		 b-name
		 ", "
		 "L="
		 (rtos l1 2 2)
		 " H1="
		 (rtos h1 2 2)
		 " H2="
		 (rtos h2 2 2)
		 " Jt="
		 (rtos j1 2 2)
		 " - Str."
	 )
;___    ;___ brick-1: line 1
	 (strcat "0,   "
		 "0,0,   "
		 "0,"
		 (rtos (+ h1 j1 h2 j1) 2 3)
		 ",   "
		 (rtos l1 2 3)
		 ",-"
		 (rtos j1 2 3)
	 )
;___ brick-1: line 2
	 (strcat "0,   "
		 "0,"
		 (rtos h1 2 3)
		 ",   "
		 "0,"
		 (rtos (+ h1 j1 h2 j1) 2 3)
		 ",   "
		 (rtos l1 2 3)
		 ",-"
		 (rtos j1 2 3)
	 )
;___ brick-1: line 3
	 (strcat "90,   "
		 "0,0,   "
		 "0,"
		 (rtos (+ l1 j1) 2 3)
		 ",   "
		 (rtos h1 2 3)
		 ",-"
		 (rtos (+ j1 h2 j1) 2 3)
	 )
;___ brick-1: line 4
	 (strcat "90,   "
		 (rtos l1 2 3)
		 ",0,   "
		 "0,"
		 (rtos (+ l1 j1) 2 3)
		 ",   "
		 (rtos h1 2 3)
		 ",-"
		 (rtos (+ j1 h2 j1) 2 3)
	 )
;___    ;___ brick-2: line 1
	 (strcat "0,   "
		 "0,"
		 (rtos (+ h1 j1) 2 3)
		 ",   "
		 "0,"
		 (rtos (+ h2 j1 h1 j1) 2 3)
		 ",   "
		 (rtos l1 2 3)
		 ",-"
		 (rtos j1 2 3)
	 )
;___ brick-2: line 2
	 (strcat "0,   "
		 "0,"
		 (rtos (+ h1 j1 h2) 2 3)
		 ",   "
		 "0,"
		 (rtos (+ h1 j1 h2 j1) 2 3)
		 ",   "
		 (rtos l1 2 3)
		 ",-"
		 (rtos j1 2 3)
	 )
;___ brick-2: line 3
	 (strcat "90,   "
		 "0,"
		 (rtos (+ h1 j1) 2 3)
		 ",   "
		 "0,"
		 (rtos (+ l1 j1) 2 3)
		 ",   "
		 (rtos h2 2 3)
		 ",-"
		 (rtos (+ j1 h1 j1) 2 3)
	 )
;___ brick-2: line 4
	 (strcat "90,   "
		 (rtos l1 2 3)
		 ","
		 (rtos (+ h1 j1) 2 3)
		 ",   "
		 "0,"
		 (rtos (+ l1 j1) 2 3)
		 ",   "
		 (rtos h2 2 3)
		 ",-"
		 (rtos (+ j1 h1 j1) 2 3)
	 )
       )
 )
				;end list/setq
				;------------------------------------------------------------------
 (if (= opt "Yes")
   (setq p-lst p-lst1)
   (setq p-lst p-lst2)
 )
 (setq n1 1)
 (foreach n p-lst
   (if	(> (strlen n) 80)
     (progn
(alert
  (strcat
    "\n Line ["
    (itoa n1)
    "] Pattern Definition Contains more than 80 Characters."
    "\n                  "
  )
)
(EXIT)
     )
   )
   (setq n1 (1+ n1))
 )
 (setq f (open (strcat dir-name b-name ".pat") "w"))
 (foreach n p-lst (write-line n f))
 (close f)
 (princ)
 (alert
   (strcat
     "\n* File ["
     b-name
     ".pat] Created in the Following Directory:"
     "\n  ["
     dir-name
     "]"
     "\n  "
     "\n                                             Press  to Continue with BHATCH Command."
    )
 )
 (setvar "hpname" b-name)
 (setvar "hpscale" 1)
 (princ)
 (command "_bhatch")
)
				;end C:BRICK;;;====================================================================
(PROMPT
 "\n Use [C:BRK] to create bricks & tiles hatch patterns. "
)
(PRINC)

 

Ca crée un motif de briques (avec 2 hauteur de briques différentes possibles) et lance la commande hachure avec le motif qui vient d'être créé.

 

Ma question est la suivante : peut-on adapter ce lisp pour avoir des lignes et des colonnes alignées (pas de joints croisés) ?

 

Merci

[kclement]

Bon, je retire ma question : j'avais zappé l'option OVERLAP qu'il propose !!!

 

Enfin, ça servira peut-être à quelqu'un quand même !

 

A+