quick hatch lisp

amyone see what i've done wrong with setting the ang? that is what is failing.

(defun C:HH ()
(setq ename (entsel "\nSelect Hatch pattern: "))
(setq ename (car ename))
(setq pat (cdr (assoc 2 (entget ename))))
(setq sca (cdr (assoc 41 (entget ename))))
(setq lay (cdr (assoc 8 (entget ename))))
(setq ang (cdr (assoc 50 (entget ename))))
(command ".LAYER" "S" lay "")
(command "BHATCH" "DR" "B" "P" Pat Sca ang pause)
(princ)
) ;end

 

I'm not sure what (assoc 50) is for, but a hatch pattern's angle is (assoc
52), and remember that it's in radians, so you'll have to convert to feed it
into the command function if your units settings are in degrees.

 

you may also want to add a trap to verify that 1. you picked something and
2. that it is hatch.


(defun C:HH (/ sset ename pat sca lay ang)
(princ "\nSelect Hatch pattern: ")
(setq sset (ssget ":S" '((0 . "hatch"))))
(if sset
(progn
(setq ename (ssname sset 0))
(setq pat (cdr (assoc 2 (entget ename))))
(setq sca (cdr (assoc 41 (entget ename))))
(setq lay (cdr (assoc 8 (entget ename))))
(setq ang (rtd (cdr (assoc 52 (entget ename)))))
;(command ".LAYER" "S" lay "");; I hate using commands for layers but
you may need to add a check to make sure it's on/thawed/unlocked
(setvar "clayer" lay)
;(command ".BHATCH" "DR" "B" "P" Pat Sca ang pause) <--- the keywords
don't match with what I have in 2002 - is this different in 2004/5?
(command "_.-bhatch" "_P" pat sca ang pause)
)
)
(princ)
) ;end

cj

 

CJ,
autocad tells me:

; error: no function definition: RTD

do you have this function definition?

Within BHatch 'dr' and 'b' sends the hatch's drawing order to back in 2005.

Thanks for your help.

 

I'd also recommend eliminating the redundant entgets.

(defun C:HH (/ sset edata ename pat sca lay ang)
(princ "\nSelect Hatch pattern: ")
(if (setq sset (ssget ":S" '((0 . "hatch"))))
(progn
(setq
ename (ssname sset 0)
edata (entget ename)
pat (cdr (assoc 2 edata))
sca (cdr (assoc 41 edata))
lay (cdr (assoc 8 edata))
ang (rtd (cdr (assoc 52 edata))))
;(command ".LAYER" "S" lay "")
(setvar "clayer" lay)
(command "_.-bhatch" "_P" pat sca ang pause)))
(princ))

 

(defun rtd (a) ;(rtd <radian value>)
(/ (* a 180.0) pi) ;this subroutine converts radians to degrees
)

this one is so old i usually forget to include it.

 

Hi ikaage,you can try my code
; eh is stand for edit hatch
; Design by Ade Suharna <>
; 5 October 2004
; Program no.102/10/2004
; Edit by James Allen <JamesA~AA~mwengrs~DD~com> 12/10/2004 1).
; by ????????? 13/10/2004 2).
(defun c:eh (/ ent info2 info41 info52 inp1 inp2 inp3 ed)
(while
(setq ent (entget (car (entsel)))
info2 (cdr (assoc 2 ent))
info41 (rtos (cdr (assoc 41 ent)))
info52 (rtos (cdr (assoc 52 ent)))
inp1
(getstring
(strcat "\nENTER NEW NAME OF HATCH PATTERN" "<" info2 ">" ": ")))
(if (eq inp1 "")(setq inp1 info2))
; 1).
(setq inp2
(getreal
(strcat "\nENTER NEW SCALE OF HATCH" "<" info41 ">" ": ")))
(if (eq inp2 nil)(setq inp2 (atoi info41)))
; 1).
(setq inp3
(getreal
(strcat "\nENTER NEW ANGLE OF HATCH" "<" info52 ">" ": ")))
(if (eq inp3 nil)(setq inp3 (atoi info52)))
; 1).
(entmod
; 2).
(subst (cons 2 inp1)(assoc 2 ent)
(subst (cons 41 inp2)(assoc 41 ent)
(subst (cons 52 inp3)(assoc 52 ent) ent))))
)
)

 

thanks to all. here's the final lisp.

(defun rtd (a) ;(rtd <radian value>)
(/ (* a 180.0) pi) ;this subroutine converts radians to degrees
)

(defun C:HH (/ sset edata ename pat sca lay ang)
(princ "\nSelect Hatch pattern: ")
(if (setq sset (ssget ":S" '((0 . "hatch"))))
(progn
(setq
ename (ssname sset 0)
edata (entget ename)
pat (cdr (assoc 2 edata))
sca (cdr (assoc 41 edata))
lay (cdr (assoc 8 edata))
ang (rtd (cdr (assoc 52 edata))))
;(command ".LAYER" "S" lay "")
(setvar "clayer" lay)
(command "_.-bhatch" "_P" pat sca ang pause)))
(princ))

 

You can remove the commented out line
;(command ".LAYER" "S" lay "")

but as i said, you may need to add a check to verify that the layer is
on/thawed/unlocked

glad it works for you.

cj