(defun c:tegole (/ dcl_id teg )
(setq dcl_id (load_dialog "tegole.dcl"))
(if
  (not (new_dialog "tegole" dcl_id)
  );;not
  (exit)
);;if
(if (= s1 "")(setq s1 "1"))
(if (< s1 "0")(setq s1 "1"))


(action_tile
"accept"
"(done_dialog) (setq userclick T)"
);;action_tile
(start_dialog)
(unload_dialog dcl_id)
(princ)

(cond
  ((= teg "T1")(t:tegoletga))
  ((= teg "T2")(t:tegoletgtred))
 );;cond
(princ)
);;defun
(defun t:tegoletga (/ qq pt pt0 dy numrows nr dx numcol nc pt1 pt2 pt3 pc1 pt4 pc2 pt5 pt6 sel1 pc3 pc4 pt7 pt8 pc5 pt9 pt10 pt11 pt12 x2 x3 y sel2 sel3 w)
(setq olderr *error*)
(setq *error* traptga)
(setq oldsnap (getvar "osmode"))
(setq oldecho  (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_undo" "_m")
(initget 7)
(setq qq (atof s1))
(setq pt (getpoint "\nSpecifica l'area da riempire:"))
(setq pt0 (getcorner pt))
        (setq dy (- (cadr pt0)(cadr pt)))
        (setq numrows (/ dy (scl 33.0) ))
        (setq nr(+ 1 (fix numrows)))
   (setq dx (- (car pt0)(car pt)))
   (setq numcol (/ dx (scl 32.9501) ))
   (setq nc (+ 1 (fix numcol)))
(setvar "osmode" 0)
(setq pt1 (polar pt (dtr 90) (scl 3.4193) ))
(setq pt2 (polar pt1 (dtr 0)  ( scl 24.3814) ))
(setq pt3 (polar pt (dtr 0) (scl 12.1907) ))
(setq pc1 (polar pt1 (dtr 0) (scl 2.9721) ))
(setq pt4 (polar pc1 (dtr 90) (scl 30.9588) ))
(setq pc2 (polar pt2 (dtr 180) (scl 2.9721) ))
(setq pt5 (polar pc2 (dtr 90) (scl 30.9588) ))
(setq pt6 (polar pt3 (dtr 90) (scl 32.4893) ))
(command "_pline" pt1 "_a" "_s" pt3 pt2 "_l" pt5 "_a"  "_s" pt6 pt4 "_l" pt1 "")
(setq sel1 (ssget "_l"))
(setq pc3 (polar pt2 (dtr 180) (scl 2.3380) ))
(setq pc4 (polar pt2 (dtr 180) (scl 2.2629) ))
(setq pt7 (polar pc3 (dtr 90) (scl 24.3533) ))
(setq pt8 (polar pt7 (dtr 0) (scl 13.2446) ))
(setq pc5 (polar pt7 (dtr 0) (scl 6.6223) ))
(setq pt9 (polar pc5 (dtr 90) (scl 1.8267) ))
(setq pt10 (polar pc4 (dtr 90) (scl 23.5709) ))
(setq pt11 (polar pt9 (dtr 270) (scl 0.8270) ))
(setq pt12 (polar pt10 (dtr 0) (scl 13.0944) ))
(command "_arc" pt7 pt9 pt8)
(setq x2 (entlast))
(setq sel1 (ssadd  x2  sel1))
(command "_arc" pt10 pt11 pt12)
(setq x3 (entlast))
(setq sel1 (ssadd  x3  sel1))
(setq y (sslength sel1))
(command "_array" sel1 "" "_r"  nr   nc   (scl 33.0) (scl 32.9501))
(setq sel2 (ssget "_P"))
(setq sel3  (ssget  pt0))
(setq *error* olderr )
(setvar "osmode" oldsnap)
(princ)
)
(defun dtr (w)
  (* pi (/ w 180.0))
)
(princ)
(defun scl (q)
 (/ q qq)
)
(princ)
(defun traptga (errmsg)
(setvar "osmode" oldsnap)
(setvar "cmdecho" oldecho)
(setq *error* olderr)
(command "_undo" "_b")
(princ)
)
(defun dtr (w)
  (* pi (/ w 180.0))
)
(princ)
(defun scl (q)
 (/ q qq)
)
(princ)
(defun t:tegoletgtred (/ qq p1 p3 p2 p4 pc1 pt1 pc2 pt2 pc3 pt3 pc4 pt4 pc5 pt5 pc6 pt6 archi pt7 pc8 pt8 pc9 pt9 pc10 pt10 pc11 pt11 arrabiu x1 m1 m2 m3 m4 m5 mir1 m6 m7 mir2 pc12 pt12 pc13 pt13 pt14 x2 pc15 pt15 pt16 pt17 x3 x4 dy dx numCOR COR numARC ARC numARRo numARRv ARRo ARRv)
(setq olderr *error*)
(setq *error* traptgtred)
(setq oldsnap (getvar "osmode"))
(setq oldecho  (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_undo" "_m")
(initget 7)
(setq qq (atof s1))
(setq p1 (getpoint "\nSpecifica l'area da riempire: "))
(setq p3 (getcorner p1))
(setvar "osmode" 0)
( setq p2 (list (car p3)(cadr p1)))
( setq p4 (list (car p1)(cadr p3)))
(setq pc1 (polar p4 (dtr 90) (scl 7.4502)))
(setq pt1 (polar pc1 (dtr 0) (scl 0.7389)))
(setq pc2 (polar pc1 (dtr 0) (scl 31.5409)))
(setq pt2 (polar pc2 (dtr 270) (scl 1.7906)))
(setq pc3 (polar pc1 (dtr 0) (scl 31.0474)))
(setq pt3 (polar pc3 (dtr 270) (scl 6.5976)))
(command "_pline" pt3 p4 pt1 pt2 "" @)
(setq cornice (ssget "_l"))
(setq pc4 (polar p4 (dtr 0) (scl 8.8772)))
(setq pt4 (polar pc4 (dtr 270) (scl 5.7138)))
(setq pc5 (polar p4 (dtr 0) (scl 5.2786)))
(setq pt5 (polar pc5 (dtr 270) (scl 1.5519)))
(setq pc6 (polar p4 (dtr 0) (scl 9.9352)))
(setq pt6 (polar pc6 (dtr 270) (scl 9.0849)))
(command "_pline" p4 "_a" "_s" pt5 pt4 "_l" pt6 "" @)
(setq archi (ssget "_l"))
(setq pt7 (polar p4 (dtr 270) (scl 9.0849)))
(setq pc8 (polar p4 (dtr 270) (scl 11.0153)))
(setq pt8 (polar pc8 (dtr 0) (scl 7.0757)))
(setq pc9 (polar p4 (dtr 270) (scl 16.2717)))
(setq pt9 (polar pc9 (dtr 0) (scl 12.1907)))
(setq pc10 (polar p4 (dtr 270) (scl 12.6941)))
(setq pt10 (polar pc10 (dtr 0) (scl 6.1115)))
(setq pc11 (polar p4 (dtr 270) (scl 17.2475)))
(setq pt11 (polar pc11 (dtr 0) (scl 10.5181)))
(command "_pline" pt7 "_a" "_s" pt8 pt9 "_l" pt11 "_a" "_s" pt10 pc8 "" @)
(setq arrabiu (ssget "_l"))
(command "_line" pt9 pt6 @)
(setq x1 (entlast))
(setq arrabiu (ssadd  x1 arrabiu))
(setq m1 (polar pt9 (dtr 0) (scl 8.5686)))
(setq m2 (polar pt11 (dtr 0) (scl 11.9138)))
(setq m3 (polar pt6 (dtr 0) (scl 13.0796)))
(setq m4 (polar pt10 (dtr 0) (scl 20.7282)))
(setq m5 (polar pc8 (dtr 0) (scl 32.9500)))
(command "_pline" m3 m1 m2 "_a"  "_s" m4 m5  "" @)
(setq mir1 (entlast))
(setq arrabiu (ssadd  mir1 arrabiu))
(setq m6 (polar pt8 (dtr 0) (scl 18.7985)))
(setq m7 (polar pt7 (dtr 0) (scl 32.9499)))
(command "_arc" m1 m6 m7 @)
(setq mir2 (entlast))
(setq arrabiu (ssadd  mir2 arrabiu))
(setq pc12 (polar p4 (dtr 270) (scl 11.8683)))
(setq pt12 (polar pc12 (dtr 0) (scl 10.8087)))
(setq pc13 (polar p4 (dtr 0) (scl 16.4750)))
(setq pt13 (polar pc13 (dtr 270) (scl 13.6832)))
(setq pt14 (polar pt12 (dtr 0) (scl 11.3326)))
(command "_arc" pt12 pt13 pt14 @ )
(setq x2 (entlast))
(setq arrabiu (ssadd  x2 arrabiu))
(setq pc15 (polar p4 (dtr 270) (scl 14.5715)))
(setq pt15 (polar pc15 (dtr 0) (scl 11.6571)))
(setq pt16 (polar pc13 (dtr 270) (scl 15.6114)))
(setq pt17 (polar pt15 (dtr 0) (scl 9.6358)))
(command "_arc" pt15 pt16 pt17 @ )
(setq x3 (entlast))
(setq arrabiu (ssadd  x3 arrabiu))
(command "_mirror" archi "" pt13 pt16  "_n"  @)
(setq x4 (entlast))
(setq archi (ssadd  x4 archi))
(setq dy (- (cadr p3)(cadr p1)))
(setq dx (- (car p3)(car p1)))
(setq numCOR (/ dX (scl 30.9628) ))
(setq COR(+ 1 (fix numCOR)))
(command "_array" cornice "" "_r"  1 COR  (scl 30.9628) )
(setq numARC (/ dX (scl 32.95)))
(setq ARC (+ 1 (fix numARC)))
(command "_array" archi "" "_r"  1 ARC  (scl 32.95) )
(setq numARRo (/ dX (scl 32.9499)))
(setq numARRv (/ dY (scl 7.2091)))
(setq ARRo(+ 1 (fix numARRo)))
(setq ARRv  (fix numARRv))
(command "_array" arrabiu "" "_r"  ARRv   ARRo  (scl -7.2091)  (scl 32.9499) )
(setvar "osmode" oldsnap)
(princ)
)
(princ)
(defun traptgtred (errmsg)
 (setvar "osmode" oldsnap)
 (setvar "cmdecho" oldecho)
 (setq *error* olderr)
 (command "_undo" "_b" )
(princ)
)
(princ)