I finished a good Beta of the hatch-pline routine...(an almost-there if you will)

Tony Lukasz

;CODING STARTS HERE
;Draws polyline boundaries around hatches.
;--------------------------------------------------------------------------
(defun c:hatch-pl (/ ent numpts plst osmo stpt lstpt arcflag pldat bdst mdpt bpt nxtpt pllst)
(setvar "CMDECHO" 0)
(command "UNDO" "BEGIN")
(setq numpts -1 plst nil
osmo (getvar "OSMODE")
stpt nil lstpt nil
arcflag 0 *error* err1
ent (entsel "\nPick Hatch:")
)
(if ent (progn
(setq ent (entget (car ent)))
(setvar "OSMODE" 0)
(foreach pldat ent
(if (= (car pldat) 93)(progn
(if (= numpts 0)(if (= arcflag 1)(arc-sub)(vert-sub)))
(setq numpts (cdr pldat))
)
)
(if (and (= (car pldat) 10) (>= numpts 0))
(if (= arcflag 1)(arc-sub)(vert-sub))
)
(if (= (car pldat) 42)(progn
(if (= (cdr pldat) 0.0)(setq arcflag 0)
(setq arcflag 1 bdst (* 0.5 (cdr pldat)))
)
)
)
)
))
(command)
(command "UNDO" "END")
(setvar "OSMODE" osmo)
(setvar "CMDECHO" 1)
(prin1)
)
;--------------------------------------------------------------------------
(defun vert-sub ()
(setq numpts (1- numpts))
(if (>= numpts 0)
(if plst
(progn
(setq lstpt (cdr pldat))
(if (null stpt)(setq stpt (cdr pldat)))
(command lstpt)
)
(progn
(setq stpt (cdr pldat) plst 1)
(command "PLINE")
(command stpt)
)
)
(progn
(command stpt)
(command "")(command)
(setq pllst (entlast))
(setq numpts -1 plst nil stpt nil lstpt nil)
(keep-pl)
)
)
)
;--------------------------------------------------------------------------
(defun arc-sub ()
(setq numpts (1- numpts))
(if (= numpts -1)(setq nxtpt stpt)(setq nxtpt (cdr pldat)))
(setq arcflag 0
bdst (* bdst (distance nxtpt lstpt))
mdpt (polar lstpt (angle lstpt nxtpt)(/ (distance lstpt nxtpt) 2.0))
bpt (polar mdpt (+ (/ pi 2.0) (angle nxtpt lstpt)) bdst)
)
(if (>= numpts 0)
(if plst
(progn
(setq lstpt (cdr pldat))
(command "A" "S" bpt lstpt "L")
)
)
(progn
(command "A" "S" bpt stpt)
(command "")(command)
(setq pllst (entlast))
(setq numpts -1 plst nil stpt nil lstpt nil)
(keep-pl)
)
)
)
;--------------------------------------------------------------------------
(defun keep-pl (/ kpstr)
(princ "\nNew boundary found - Keep new boundary? (<Y>/N):")
(command "SELECT" pllst)
(initget "Y y N n")
(setq kpstr (getkword))
(if (or (= kpstr "")(= kpstr " ")(null kpstr))(setq kpstr "Y"))
(if (= (strcase kpstr) "N")(progn (command)(command "ERASE" pllst "")))
(command)
)
;--------------------------------------------------------------------------
(defun err1 (emsg)
(command)
(command "UNDO" "END")
(command "UNDO")
(command)
(setvar "OSMODE" osmo)
(princ "\nERROR - ")(princ emsg)(princ "... ")
(setq *error* nil)
(prin1)
)
(prin1)
;CODING ENDS HERE