SSGET Crossing using SSGET "X"

I have been searching online and have not found how to use SSGET "X"
and then filter only the entites (specifically solid hatches) that are
crossing a box with LL and UR corners. I can use the SSGET "C" and
specify the LL and UR corners; however, this is dependent on the zoom
and I want a zoom independent function because zooming to 20,000
objects adds a lot of run time to the routine.

I am writing a program to rebuild exterior and interiror boundaries of
individual hatches that may or may not be touching. I have about
26,000 individual solid hatches and I would like to combine the
adjacent hatches so I can generate fewer hatches and/or hatch patterns.
I am using the SSGET "C" as specified above; however, zooming in and
out is time consuming.

My algorithim essentially loops over all the selected hatches, and then
for each hatch edge, the midpoint is computed, and a pickbox is created
to select all solid hatches touching that edge midpoint within a
tolerance. If there is only one hatch selected, then a line segment is
drawn along the edge. If more than one hatch objects are found, then
move on to the next edge and repeat the test for adjacent hatches at
the edge midpoint. Once all the solid hatches have been looped over,
the exterior and interior line segments have all been drawn. Now I can
re-hatch fewer large areas instead of lots of small areas.

Any ideas on how to get around zooming in and out to make this routine
more efficient? Is there a better way to build these boundaries?

Thanks in advance for your help.

Rock

Here is what I have...


;;; Draws lines along exterior and interior boundaries of hatched areas
(defun c:clean_hatch (/)

(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "snapmode" 0)
(setq curlay (getvar "CLAYER"))

(princ
"\nPick hatch entities to clean: "
)
(setq ss1 (ssget (list (cons 0 "HATCH"))))
(if (/= ss1 nil)
(setq ss1_len (sslength ss1))
(setq ss1_len 0)
) ;_if

;; Loop over all hatches
(setq j 0)
(while (< j ss1_len)
(progn
(setq en (ssname ss1 j))
;;(command "_zoom" "O" en "")
(setq ent (entget en))

(setq lay (cdr (assoc 8 ent)))
(setq vlist1 (cdr (LI_mitem 10 ent)))
(setq vlist2 (LI_mitem 11 ent))

;; Loop over all coordiantes
(setq i 0)
(repeat (length vlist2)
(progn
(setq pt1 (midPt (nth i vlist1) (nth i vlist2)))
(setq rect_lst (PickPntExpand pt1 0.005))
;;(setq ss2 (ssget "C" pt1 pt1 (list (cons 8 lay))))
;;(command "_rectang" (nth 0 rect_lst) (nth 1 rect_lst))

(setq ss2
(ssget "C"
(nth 0 rect_lst)
(nth 1 rect_lst)
(list
(cons -4 "<AND")
(cons 8 lay)
(cons 0 "HATCH")
(cons -4 "AND>")
)
)
)

;;(setq ss2 (cc lay (nth 0 rect_lst) (nth 1 rect_lst)))
(if (/= ss2 nil)
(progn
(setq ss2_len (sslength ss2))
;;; (princ "\nMidpoint picked entities")
;;; (command "_rectangle")
;;; (mapcar 'command rect_lst)
;;; (setq k 0)
) ;_progn
(progn
;;; (princ "\nMidpoint picked nothing")
;;; (command "_rectangle")
;;; (mapcar 'command rect_lst)
;;; (setq k 0)
) ;_progn
) ;_if
(if (= ss2_len 1)
(progn
(setq pt1 (list (round (car (nth i vlist1)) 5)
(round (cadr (nth i vlist1)) 5)
)
)
(setq pt2 (list (round (car (nth i vlist2)) 5)
(round (cadr (nth i vlist2)) 5)
)
)
(command "_pline" pt1 pt2 "")
) ;_progn
) ;_if

(setq i (+ i 1))
) ;_progn
) ;_while
(setq j (+ j 1))
) ;_progn
) ;_while

;;(c:ze)
(princ)

) ;_defun

;;; Program to compute the midpoint between pt1 and pt2
(defun midPt (pt_1 pt_2 /)
(polar pt_1
(angle pt_1 pt_2)
(/ (distance pt_1 pt_2) 2)
)
) ;_defun

;; !
**************************************************************************
;; ! LI_mitem
*
;; !
**************************************************************************
;; ! Function : Return Multiple instances of a DXF code dotted pair
from the *
;; ! entity list.
*
;; ! Argument : 'Code' - The DXF Code to check
*
;; ! 'alist' - The List to check
*
;; ! Returns : A list of all DXF dotted pair values, if it exists else
*
;; ! return nil
*
;; ! Update : December 26, 1998
*
;; ! Copyright: (C) 2000, Four Dimension Technologies, Singapore
*
;; ! Contact : for help/support/info
*
;; !
**************************************************************************
(defun LI_mitem (Code entl / Lst itm)
(setq Lst '())
(foreach itm entl
(if (= (car itm) Code)
(setq Lst (cons (reverse (cdr (reverse (cdr itm)))) Lst))
)
)
(if Lst
(reverse Lst)
nil
)
)

;;;------------------------------------------------------------------------­-

;;; PickPntExpand
;;; Will return a list of 2 points that define a rectangle based on the

;;; provided size
;;; ---
;;; Paramaters
;;; PkPnt - A point list
;;; Growth - size of rectangle
;;; ---
;;; Example:
;;; (pickPntExpand '(0.0 0.0 0.0) 10)
;;; returns ((-5.0 -5.0 0.0)(5.0 5.0 0.0))
;;;------------------------------------------------------------------------­-

(defun PickPntExpand (PkPnt Growth / PolarDist BotCnr TopCnr)
(setq PolarDist (sqrt (* (expt (/ (float Growth) 2) 2) 2)))
(append
(list (setq BotCnr (polar PkPnt (* pi 1.25) PolarDist)))
(list (setq TopCnr (polar PkPnt (/ pi 4) PolarDist)))
) ;_ end of append
) ;_ end of defun

;;; usage (round expression numdecimalplaces)
;;; if numdecimalplaces = 0 then returned value is
;;; an integer (following VBA language reference).
(defun round (val prec / expp retVal)
(setq expp (expt 10 prec)
retVal (* (/ 1.0 expp) (fix (+ (* expp val) 0.5)))
)
(if (= prec 0)
(fix retVal)
retVal
)
)

;;; Program to select using crossing box
;;; this doesn't work.... yet
(defun cc (layer LL UR /)
;;a crossing version
(setq
SS (ssget "X"
(list '(-4 . "<AND")
(cons 8 layer)
(cons 0 "HATCH")
'(-4 . "<OR")
'(-4 . ">,>")
(cons 10 LL)
'(-4 . ">,>")
(cons 11 LL)
'(-4 . "OR>")
'(-4 . "<OR")
'(-4 . "<,<")
(cons 10 UR)
'(-4 . "<,<")
(cons 11 UR)
'(-4 . "OR>")
'(-4 . "AND>")
)
)
)
(command "select" SS)
)