try these out......
;;;Misc hatch routines
;;;============================================================================
;;; Hatch Between two parallel lines
;;;============================================================================
;;;============================================================================
;;; DH-2line places hatch between two parallel lines
;;; Creates ANSI37 hatch 90 deg
(defun C:DH-2line (/ usercmd ss er e1 e2 p1 p2 p3 p4 xp1 xp2 xp3 xp4 yp1
yp2 yp3 yp4 ang HS RB)
(setq usercmd (getvar "CMDECHO")
ss nil
er nil
HS "" ; Hatch Scale
RB "N" ; Retain Border
)
(setvar "CMDECHO" 0)
(while (not ss)
(prompt "\nSelect two parallel lines to hatch")
(setq ss (ssget)) ; ":S" may be used
(Cond
((equal ss nil)
(setq er "Nothing selected:")
)
((< (sslength SS) 2)
(setq er "too few lines selected.")
)
((> (sslength SS) 2)
(setq er "too many lines selected.")
)
(T
(setq e1 (entget (ssname ss 0)))
(setq e2 (entget (ssname ss 1)))
(if (and (= (cdr (assoc 0 e1)) "LINE")
(= (cdr (assoc 0 e2)) "LINE")
)
(progn ; Both are LINES
(setq p1 (cdr (assoc 10 e1)) ; Get end points of lines
p2 (cdr (assoc 11 e1))
p3 (cdr (assoc 10 e2))
p4 (cdr (assoc 11 e2))
)
(setq xp1 (car p1) ; get x & y values of end points
xp2 (car p2)
xp3 (car p3)
xp4 (car p4)
yp1 (cadr p1)
yp2 (cadr p2)
yp3 (cadr p3)
yp4 (cadr p4)
)
; Correct for cases where two points are not exactly equal (+/- .1)
(Setq xp1 (if (equal xp1 xp2 0.1) xp2 xp1)) ; make exactly equal
(Setq xp3 (if (equal xp3 xp4 0.1) xp4 xp3)) ; make exactly equal
(Setq yp1 (if (equal yp1 yp2 0.1) yp2 yp1)) ; make exactly equal
(Setq yp3 (if (equal yp3 yp4 0.1) yp4 yp3)) ; make exactly equal
(if (or (> xp1 xp2) (and (= xp1 xp2) (> yp1 yp2))) ; Swap ends
(setq px p1 ; make starting ends the same
p1 p2 ; by swaping ends
p2 px
)
)
(if (or (> xp3 xp4) (and (= xp3 xp4) (> yp3 yp4)))
(setq px p3 ; make starting ends the same
p3 p4 ; by swaping ends
p4 px
)
)
;;;============================================================================
(setq ang (* 0.0 (/ (+ (angle p1 p2) (* pi 0.5)) pi))) ; Hatch @ 0 deg to line
(setq pi2 (* pi 2)
a1 (angle p1 p2) ; check for >= 2pi angle, set to 0 or correct to < 2pi
a1 (if (equal a1 pi2 0.0001) 0 (if (> a1 pi2) (- a1 pi2)a1))
a2 (angle p3 p4)
a2 (if (equal a2 pi2 0.0001) 0 (if (> a2 pi2) (- a2 pi2)a2))
)
(if (not (equal a1 a2 0.1)) ; (margin +/- 0.1 inch)
(setq er "lines are not parallel.")
; Lines OK to Hatch
(command "_.hatch" "" HS ang "" RB p1 p2 p4 p3 "close" "" )
) ; endif
;;;============================================================================
) ;end progn
(setq er "one or both item(s) not a LINE.")
) ; endif
) ; end (T)
) ; end cond
) ; end while
(if (/= er nil)
(alert (strcat "ERROR: " er))
)
(setvar "CMDECHO" usercmd)
(princ)
) ; end defun
(Princ)
;;;============================================================================
;;;============================================================================
;;; Hatch- three point
;;;============================================================================
;;;============================================================================
;;; DH3 uses points picked for three Corners, long side then width
;;; Creates ANSI37 hatch 90 deg
(defun C:dh3 (/ p1 p2 p3 p4 hs rb ang usercmd )
;Make 2D point from 3D point
(defun 3dP->2dP (3dpt) (list (car 3dpt) (cadr 3dpt)))
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(prompt "\nPick boundry points to hatch")
(setq p1 (getPoint "\nPick first point:")
p2 (getPoint p1 "\nPick along Pipe first:")
p3 (getPoint p2 "\nPick across Pipe:")
p1 (3dP->2dP p1)
p2 (3dP->2dP p2)
p3 (3dP->2dP p3)
p4 (polar p1 (angle p2 p3) (distance p2 p3))
HS 30 ; Hatch Scale
RB "N" ; Retain Border
ang (* 180.0 (/ (+ (angle p1 p2) (* pi 0.5)) pi))
)
(command "_.hatch" "" "" ang "" RB p1 p2 p3 p4 "close" "" )
(setvar "CMDECHO" usercmd)
(princ)
)
(Princ)
;;;===========================================================
;;; Hatch - Unlimited points
;;;===========================================================
(defun c:DH (/ hs ang usercmd)
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(prompt "\nDraw a polyline boundry to hatch, Enter when done.")
(setq hs "" ; Hatch Scale
ang 0 ; Hatch angle
)
(command "_.hatch" "" HS ang "" "n")
(setvar "CMDECHO" usercmd)
(princ)
); end defun
(princ)
;
;
;
;;;==============================================================================
;;; Hatch - Creates separate hatch with several objects
;;;===============================================================================
(defun c:mhatch (/ sset idx hnd cmdecho)
(setq cmdecho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq sset
(ssget
'((-4 . "<OR") (0 . "POLYLINE") (0 . "LWPOLYLINE") (-4 . "OR>"))
)
)
(if sset
(progn
(command "UNDO" "_begin")
(setq idx (sslength sset))
(while (>= (setq idx (1- idx)) 0)
(setq hnd (ssname sset idx))
(command "_.hatch" "" "" "" hnd "")
)
(command "UNDO" "_end")
)
)
(setvar "CMDECHO" cmdecho)
(princ)
)
;;;==============================================================================
;;; Hatch- Quick pick hatch command
;;;===============================================================================
(defun c:h (/ ss)
(setvar "cmdecho" 0)
(prompt "\n*** Select objects for Hatch & press [Enter] ")
(if (and
(setq ss (ssget))
(> (sslength ss) 0)
)
(command "hatch" "" "" "" ss "")
)
(princ)
)
;;;==============================================================================
;;; Hatch - Matches the properties of existing hatches (sets only)
;;;===============================================================================
;; Match properties of hatch pattern selected
;; Set system variables to match
(defun c:hs (/ ent elist lay colr)
(if (setq ent (entsel))
(progn
(setq elist (entget (car ent)))
(if (= (cdr (assoc 0 elist)) "HATCH")
(progn
(command "_undo" "_begin")
(setq lay (cdr (assoc 8 elist)))
(setq colr (cdr (assoc 62 elist)))
(setvar "hpname" (cdr (assoc 2 elist)))
(setvar "hpang" (cdr (assoc 52 elist)))
(if (or (= (substr (getvar "hpname") 1 2) "_U")
(= (substr (getvar "hpname") 1 1) "U")
)
(progn
(if (= (cdr (assoc 78 elist)) 2)
(setvar "hpdouble" 1)
)
(if (= (cdr (assoc 78 elist)) 1)
(setvar "hpdouble" 0)
)
(setvar "hpspace" (cdr (assoc 41 elist)))
)
(setvar "hpscale" (cdr (assoc 41 elist)))
)
(command "_layer" "s" lay "")
(if (null colr)
(setvar "cecolor" "256")
(setvar "cecolor" (itoa (cdr (assoc 62 elist))))
)
(command "_undo" "_end")
(if c:r
(c:r)
(redraw)
)
)
(prompt "\nSelection is not a hatch")
)
)
(prompt "\nNothing selected")
)
(princ)
)
;;;===================================================================================
;;;Hatch - Matches existing hatch and allows user to pick new object
;;;===================================================================================
(defun c:mh (/ ocol olay col ent lay hat sca rot po)
(setq ocol (getvar "cecolor"))
(setq olay (getvar "clayer"))
(setq oosn (getvar "osmode"))
(setvar "osmode" 0)
(if (setq ent (entsel "\nSelect a hatch pattern to copy."))
(progn
(setq ent (entget (car ent)))
(if (= (cdr (assoc 0 ent)) "HATCH")
(progn
(setq lay (cdr (assoc 8 ent)))
(setq hat (cdr (assoc 2 ent)))
(setq sca (cdr (assoc 41 ent)))
(setq rot (cdr (assoc 52 ent)))
(setq rot (* rot (/ 180 pi)))
(setq col (cdr (assoc 62 ent))) ; may return nil
(cond
((or (= col "BYLAYER") (= col "BYBLOCK"))
(setvar "cecolor" col)
)
((= (type col) 'int)
(setvar "cecolor" (itoa col))
)
)
(command "layer" "s" lay "")
(initget "s") ; this allows numbers to be entered
(setq po
(getpoint "\nSelect Internal Point or (S)elect Objects:")
)
(if (= (type po) 'list)
(command "-bhatch" po "p" hat sca rot "")
(if (setq po (ssget)) ; allow one choice only
(command "-bhatch" "s" po "" "p" hat sca rot "")
(prompt "\nNothing selected.")
)
)
)
(prompt "\nSelection was not a hatch.")
)
)
(prompt "\nNothing selected.")
)
(setvar "clayer" olay)
(setvar "cecolor" ocol)
(setvar "osmode" oosn)
(princ)
)
;;;===================================================================================
;;; Hatch - 2-point hatch
;;;===================================================================================
(DEFUN C:2PHATCH ()
(SETVAR "CMDECHO" 0)
(SETQ
X1 (GETPOINT "\nPick 1st corner:")
Y2 (GETCORNER X1
"\nPick opposite corner: ")
LEN1 (DISTANCE X1 Y2)
ANG1 (ANGLE X1 Y2)
X2 (POLAR X1 0.0
(* LEN1 (COS ANG1)))
Y1 (POLAR Y2 PI
(* LEN1 (COS ANG1)))
)
(command "_.hatch" "" "" "" "" "n" X1 X2 Y2 Y1 "close" "")
(SETVAR "CMDECHO" 1)
(PRINC)
)
;;;===================================================================================
;;; Hatch - 2-point circular
;;;===================================================================================
(defun c:cdh ( )
(command "osmode" "16")
(command "circle" "2p" pause pause)
(command)(command)
(command "Hatch" "" pause 0 "L" "" "erase" "P" "")
(command "osmode" "0")
)
;;;===================================================================================
;;; Hatch - Pick internal point
;;;===================================================================================
(defun c:hI (/ sSet *error*)
(defun *error* (msg)
(setvar "cmdecho" 1)
); end *error*
(setvar "cmdecho" 0)
(setq ent1 (getpoint "*** Select POINT for Hatch "))
(command "_.-bhatch" ent1 "" "")
(while (= 1 (getvar "cmdactive"))
(command pause)
); end while
(command "")
(princ)
)
