[Autolisp] Auto hatch colour from 1to255

[Anonymous]

Hi Guys,

I am writing a lisp to automatically draw some squares and hatch them in solid pattern, the first one is colour 1 and the second one is colour 2, the lisp will stop at colour 255. 

I am new to lisp and wrote a very very dumb lisp as below, is there any smarter way to do this?

(defun dtr ( deg ) (* pi (/ deg 180.0)))

(defun c:h1 ()

(setq oldlayer (getvar "CLAYER"))
(Command "LAYER" "M" "EL08" "C" "8" "" "")
(command "osmode" 0)

(setq a 50) ;set the square size and base point for hatch
(setq colour 0) ;

(setq p0 (getpoint "\nEnter rec point : "))
(setq p1 (polar p0 (DTR 0) a))
(command "rectang" p0 "D" a a p0)
(command "copy" "L" "" p0 "A" 15 p1 "")

(setq p1 (getpoint "\nEnter rec point : "))
(command "-hatch" "p" "s" "" )
(command "-hatch" "co" (+ colour 1) "" "")
(command "-hatch" p1 "" "")

(setq p2 (polar p1 (DTR 0) a))
(command "-hatch" "co" (+ colour 2) "" "")
(command "-hatch" p2 "" "")

(setq p3 (polar p2 (DTR 0) a))
(command "-hatch" "co" (+ colour 3) "" "")
(command "-hatch" p3 "" "")

(setq p4 (polar p3 (DTR 0) a))
(command "-hatch" "co" (+ colour 4) "" "")
(command "-hatch" p4 "" "")

(setq p5 (polar p4 (DTR 0) a))
(command "-hatch" "co" (+ colour 5) "" "")
(command "-hatch" p5 "" "")

(setq p6 (polar p5 (DTR 0) a))
(command "-hatch" "co" (+ colour 6) "" "")
(command "-hatch" p6 "" "")

(setq p7 (polar p6 (DTR 0) a))
(command "-hatch" "co" (+ colour 7) "" "")
(command "-hatch" p7 "" "")

(setq p8 (polar p7 (DTR 0) a))
(command "-hatch" "co" (+ colour 8) "" "")
(command "-hatch" p8 "" "")

(setq p9 (polar p8 (DTR 0) a))
(command "-hatch" "co" (+ colour 9) "" "")
(command "-hatch" p9 "" "")

(setq p10 (polar p9 (DTR 0) a))
(command "-hatch" "co" (+ colour 10) "" "")
(command "-hatch" p10 "" "")

(setq p11 (polar p10 (DTR 0) a))
(command "-hatch" "co" (+ colour 11) "" "")
(command "-hatch" p11 "" "")

(setq p12 (polar p11 (DTR 0) a))
(command "-hatch" "co" (+ colour 12) "" "")
(command "-hatch" p12 "" "")

(setq p13 (polar p12 (DTR 0) a))
(command "-hatch" "co" (+ colour 13) "" "")
(command "-hatch" p13 "" "")

(setq p14 (polar p13 (DTR 0) a))
(command "-hatch" "co" (+ colour 14) "" "")
(command "-hatch" p14 "" "")

(setq p15 (polar p14 (DTR 0) a))
(command "-hatch" "co" (+ colour 15) "" "")
(command "-hatch" p15 "" "")

(setq p16 (polar p15 (DTR 0) a))
(command "-hatch" "co" (+ colour 16) "" "")
(command "-hatch" p16 "" "")

(setvar "CLAYER" oldlayer)
(command "osmode" 255)

(princ)
)

Many thanks for you comments

Leo

[paullimapa · Accepted solution]

Try this:

(defun c:h1 (/ a colour dtr num oldlayer p0 p1) ; declare local variables

(defun dtr ( deg ) (* pi (/ deg 180.0)))

 
(setq oldlayer (getvar "CLAYER"))
(Command "LAYER" "M" "EL08" "C" "8" "" "")
(command "osmode" 0)

(setq a 50) ;set the square size and base point for hatch
(setq colour 0) ;

(setq num (getint"\nEnter Number of Squares 1-255<1>:")) ; allow user input on # of squares

(if(not num)(setq num 1)) ; if user hit Enter/Return set number to 1

(setq p0 (getpoint "\nEnter rec point : "))
(setq p1 (polar p0 (DTR 0) a))
(command "rectang" p0 "D" a a p0)
(command "copy" "L" "" p0 "A" num p1 "")

(setq p1 (getpoint "\nEnter rec point : "))

(command "-hatch" "p" "s" "" )

(repeat num

 (setq (colour (+ colour 1)))

 (command "-hatch" "co" colour "" "")
 (command "-hatch" p1 "" "")

 (setq p1 (polar p1 (DTR 0) a))

) ; repeat

(setvar "CLAYER" oldlayer)
(command "osmode" 255)

(princ)
)

Area Object Link | Attribute Modifier | Dwg Setup | Feet-Inch Calculator
Layer Apps | List on Steroids | VP Zoom Scales |Exchange App Store

[Anonymous]

Pli you are awesome!

Your lisp runs almost perfectly, just on this line I erased a set of ()

(setq (colour (+ colour 1))) 

Many thanks!

Leo

[paullimapa]

glad you caught that error...cheers.

Area Object Link | Attribute Modifier | Dwg Setup | Feet-Inch Calculator
Layer Apps | List on Steroids | VP Zoom Scales |Exchange App Store

[jdiala]

Took me a little time to pull this off. better late than never.

This should be a little faster...

(defun C:H1 (/ p s col p1 p2 p3 p4 make_hatch&pol)
(defun make_hatch&pol (a b c d)
(entmakex 
     (list 
       (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline")
       (cons 8 "EL08")(cons 90 4) (cons 70 1)(cons 10 a)(cons 10 b)(cons 10 c)(cons 10 d) 
     )
   )
(entmake  (list 
(cons 0 "HATCH")(cons 100 "AcDbEntity")(cons 8 "EL08")   (cons 62 col)
    (cons 100 "AcDbHatch")  (cons  10 (list 0.0 0.0 0.0))    (cons 210 (list 0.0 0.0 1.0))
    '(2 . "SOLID")    '(70 . 1)    '(71 . 0)    '(91 . 1)    '(92 . 1)
    '(93 . 4)    '(72 . 1)   (cons 10 a)    (cons 11 b)    '(72 . 1)
    (cons 10 b)    (cons 11 c)    '(72 . 1)    (cons 10 c)    (cons 11 d)
    '(72 . 1)    (cons 10 d)    (cons 11 a)    '(97 . 0)    '(75 . 1)
    '(76 . 1)    '(98 . 1)    (cons 10 (list 0.0 0.0 0.0)) )))
 (if (not (tblsearch "layer" "EL08"))
(Command "LAYER" "M" "EL08" "C" "8" "" "")
 )
(setq p (getpoint "\nSelect a point: ")
      s 50  ; square size       
      col 0)

(while (< col 256)
  (setq p1 (polar p 0 s)
        p p1
        p2 (polar p1 (/ pi 2.) s)
        p3 (polar p2 pi s)
        p4 (polar p3 (* pi 1.5) s)
  )
 (make_hatch&pol p1 p2 p3 p4)
 (setq col (1+ col)) 
)
)