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)
)

 

Sorry... but I didn't even look at you code

Here is a LISP routine I wrote a long time ago. It allows you to select one
or more layers (enter layer1,layer2,layer3, etc - with NO spaces and a comma
between them). Or use an astrix for 'all layers'...

Then you get to select entity type that you want to select (hatch, lines,
circles, etc).

Then you can choose what to do with them (erase, move, change, etc).

In this you should be able to get what you want (or use the LSP file as is).

I call the LSP routine ISE (Item Select Edit)...




;; Edit Items Selected by Layer

; ---------
; finds True last entity on drawing
; ---------
(DEFUN lastent (/ ent1 ent2)
(setq ent1 (entlast))
(while (setq ent2 (entnext ent1))
(setq ent1 ent2)
)
ent1
)


; *** Routine to make a Global Variable with selected Layer Names for Edit
(DEFUN SelLyrs ( / Lse_var_1 Lse_var_2 Lse_vare_1)
(cond
((/= Lse_var nil)
(initget (+ 1))
(setq Lse_var_1 Lse_var)
(princ "\nEnter an Astrix '*' for All layers.")
(setq Lse_var_2 (strcat "Enter Layers <"Lse_var_1"> for Editing: "))
(terpri)
(setq Lse_vare_1 (getstring Lse_var_2))
(if (= Lse_vare_1 "") (setq Lse_var Lse_var) (setq Lse_var Lse_vare_1))
) ; end of if

((= Lse_var nil)
(initget (+ 1))
(princ "\nEnter an Astrix '*' for All layers...")
(setq Lse_var (getstring "\nEnter Layers for Editing: "))
(terpri)
(if (null Lse_var) (setq Lse_var "*")) ;default to "*"
) ; end of =
) ;cond
Lse_var

(princ)
) ;SelLyrs

; *** Pick the Selection set Entity type
(DEFUN Get_ent ( )
(setq ss1 (ssget (list (cons 0 Item_nam) (cons 8 Item_lyr))))
)

; *** Pick the Selection set Entity type
(DEFUN Get_3Dent ( )
(setq ss1 (ssget (list (cons 210 Item_nam) (cons 8 Item_lyr))))
)

; *** Modify the Selection set
(DEFUN Mod_ent ( )
(command Item_mod "P" "")
)

; *** Explode the Selection set
(DEFUN Exp_ent ( )
(textpage) (textscr)
(princ "\n ")
(princ "\n NOTE: you selected the Explode command... ")
(princ "\n--> You will Have to explode the selection set 'manually' by")
(princ "\n--> the following Command....")
(princ "\n ")
(princ "\n Explode - then P [for Previous] - Return")
(princ "\n ")
(terpri)
)

; *** Nothing for Modifying selection set made
(DEFUN Endit ( )
(terpri)
)


; ********************
; *** Main Program ***
; ********************
(DEFUN C:ISE ( )

; Go and Select Layers to Edit
(SelLyrs)

; Choose Layers to Edit
(terpri)
(if (= Lse_var "") (setq Lse_var "*") (setq Lse_var Lse_var)) ; All layers
selected
(setq Lse_var_1 Lse_var)
(princ "\nLayers for Edit are: ") (princ Lse_var)
(setq Item_lyr Lse_var)

; Make Selection set
(setq ss1 nil) ; clear old selection set
(initget (+ 2))
(princ "\nSelect: 1=Arc 2=Circle 3=Line 4=Pline 5=Point 6=Text")
(princ "\n 7=Dimension 8=Block/Hatch 9=3D Faces 10=Mtext ")
(setq Ent_typ
(Getreal "\n 11=Solid: "))
(terpri)
(princ "\n ")

(cond ((= Ent_typ 1) (setq Item_nam (apply 'strcat '("Arc"))) (Get_ent))
((= Ent_typ 2) (setq Item_nam (apply 'strcat '("Circle"))) (Get_ent))
((= Ent_typ 3) (setq Item_nam (apply 'strcat '("Line"))) (Get_ent))
((= Ent_typ 4) (setq Item_nam (apply 'strcat '("PolyLine"))) (Get_ent))
((= Ent_typ 5) (setq Item_nam (apply 'strcat '("Point"))) (Get_ent))
((= Ent_typ 6) (setq Item_nam (apply 'strcat '("Text"))) (Get_ent))
((= Ent_typ 7) (setq Item_nam (apply 'strcat '("Dimension"))) (Get_ent))
((= Ent_typ 8) (setq Item_nam (apply 'strcat '("Insert"))) (Get_ent))
((= Ent_typ 9) (setq Item_nam (apply 'strcat '("3D Face"))) (Get_3Dent))
((= Ent_typ 10) (setq Item_nam (apply 'strcat '("Mtext"))) (Get_ent))
((= Ent_typ 11) (setq Item_nam (apply 'strcat '("Solid"))) (Get_ent))
)

; Now Modify the Selection set
(initget (+ 2))
(princ "\nSelect: 1=ChProp 2=Copy 3=Erase 4=Mirror 5=Move")
(setq Ent_Mod
(Getreal "\n 6=Rotate 7=Scale 8=Explode 9=Change 99=None: ")
)
(terpri)

; go and Modify
(cond ((= Ent_Mod 1) (setq Item_mod (apply 'strcat '("Chprop"))) (Mod_ent))
((= Ent_Mod 2) (setq Item_mod (apply 'strcat '("Copy"))) (Mod_ent))
((= Ent_Mod 3) (setq Item_mod (apply 'strcat '("Erase"))) (Mod_ent))
((= Ent_Mod 4) (setq Item_mod (apply 'strcat '("Mirror"))) (Mod_ent))
((= Ent_Mod 5) (setq Item_mod (apply 'strcat '("Move"))) (Mod_ent))
((= Ent_Mod 6) (setq Item_mod (apply 'strcat '("Rotate"))) (Mod_ent))
((= Ent_Mod 7) (setq Item_mod (apply 'strcat '("Scale"))) (Mod_ent))
((= Ent_Mod 8) (Exp_ent))
((= Ent_Mod 9) (setq Item_mod (apply 'strcat '("Change"))) (Mod_ent))
((= Ent_Mod 99) (setq Item_mod (apply 'strcat '(""))) (Endit))
)
) ;DEFUN

 

Mr. B... Thanks for the reply, however your code doens't address the
solution I am searching for. I am trying to select entities using a
crossing window that is independent of the zoom. The SSGET "C" LL UR
command works, but only when zoomed in. I need to somehow use SSGET
"X" and specify filters to select entities intersected by the LL UR
pickbox. I don't know if this is possible, though...

Rock

 

I guess nobody has an answer or nobody reads this group... Is there a
better group to post this message to and get some help?

 

Rock said the following on 11/13/2005 1:23 PM:

Your dealer
ADN network
Autodesk discussion groups
AUGI forums
CADTutor forums

 

This being the first time I've seen your message, I have to ask what you're try to do?
R. Wink

 

Hi
I also am confused --- the Ssget "x" are from what I know ,made to
travel the entity database for specific fields ; '(8 . layername) and
'(62 . "color") aso. It return the entities that ansver the search so,
but the search list are quoted, so isn't the solution to program your
own SSSget function that travel all entities for what criteria you can
state ?

Why is it you can't sort out within the Ssget search options , -- Ssget
"x" is not particular for selection sets found with a window, it is
rather a filter for entities found by being on a specific layer, a
cirtain color or both.

 

The SSGET options such as "C" is dependent on the zoom resolution.
When I use this "C" method, I have to first zoom into the region where
I am searching for entities crossed by my pickbox (LL, UR). When
zooming into 20,000 objects, it really slows down the routine. If I
don't zoom in, then crossing entities are not selected properly.

This is a bit of code that i found online. It is supposed to work to
select lines based on a crossing box and is independent of the zoom
resolution. I need to get it to work with solid hatches instead of
lines, but solid hatches have multiple 10,11 codes specifiying the 4
edges of the solid hatch.

I guess the only other option I see is to use the intersect command to
find intersections of 2 lines and loop over each edge of the solid
hatch. I don't know if this will be more efficient or not.

Thanks for the help.

Rock


;;; 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)
)

 

This is an old lisp routine that I picked up that shows how to use a filter with SSGET. It may give you an idea of how to
structure a sort routine.
R. Wink

;-----------------------------------------------------------------------------+
; |
; SSX.LSP |
; |
; Larry Knott Version 2.0 7/18/88 |
; |
; "(SSX)" - Easy SSGET filter routine. |
; |
; Creates a selection set. Either type "(SSX)" at the "Command:" prompt |
; to create a "previous" selection set or type "(SSX)" in response to any |
; "Select objects:" prompt. You may use the functions "(A)" to add |
; entities and "(R)" to remove entities from a selection set during object |
; selection. More than one filter criteria can be used at a time. |
; |
;-----------------------------------------------------------------------------|

;--------------------------- INTERNAL ERROR HANDLER --------------------------|

(defun ssx-err (s) ; If an error (such as CTRL-C) occurs
; while this command is active...
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(setq *error* olderr) ; Restore old *error* handler
(princ)
)

;-------------------------- ADD AND REMOVE FUNCTIONS -------------------------|

(defun r() (command "r") (ssx))
(defun a() (command "a") (ssx))

;-------------------------------- MAIN PROGRAM -------------------------------|

(defun ssx (/ olderr t1 t2 t3 f1 f2)
(setq olderr *error* *error* ssx-err t1 T f2 'f1)
(while t1
(initget "Block Color Entity LAyer LType Style Thickness")
(setq t1 (getkword
"\n>>Block name/Color/Entity/LAyer/LType/Style/Thickness: "))
(setq t2
(cond
((eq t1 "Block") 2) ((eq t1 "Color") 62)
((eq t1 "Entity") 0) ((eq t1 "LAyer") 8)
((eq t1 "LType") 6) ((eq t1 "Style") 7)
((eq t1 "Thickness") 39)))
(initget 1)
(setq t3
(cond
((= t2 2) (getstring "\n>>Block name: "))
((= t2 62) (initget "?")
(while
(or (eq (setq t3 (getint "\n>>Color number/<?>: ")) "?")
(null t3)
(> t3 256)
(< t3 0))
(textscr)
(princ "\n ")
(princ "\n Color number | Standard meaning ")
(princ "\n ________________|____________________")
(princ "\n | ")
(princ "\n 0 | <BYBLOCK> ")
(princ "\n 1 | Red ")
(princ "\n 2 | Yellow ")
(princ "\n 3 | Green ")
(princ "\n 4 | Cyan ")
(princ "\n 5 | Blue ")
(princ "\n 6 | Magenta ")
(princ "\n 7 | White ")
(princ "\n 8...255 | -Varies- ")
(princ "\n 256 | <BYLAYER> ")
(princ "\n \n\n\n")
(initget "?")) t3)
((= t2 0) (getstring "\n>>Entity type: "))
((= t2 8) (getstring "\n>>Layer name: "))
((= t2 6) (getstring "\n>>Linetype name: "))
((= t2 7) (getstring "\n>>Text style name: "))
((= t2 39) (getreal "\n>>Thickness: "))
(T nil)))
(if t3 (setq f1 (cons (cons t2 t3) f1)))
)
(setq f2 (ssget "x" (eval f2)))
(setq *error* olderr)
(if (and f1 f2) f2 (progn (princ "\n0 found.") (prin1)))
)

 

Hi

That must be the line;

(setq f2 (ssget "x" (eval f2)))

--------- From what I can see it just evaluate the code list '(8 .
layername) or '(62 . Color)
It don't place a window or search within the corners of a window.
Interesting though as the search list are evaluated within the Ssget
function, but tha't just Lisp )

 

That's not LISP, that's a clever programmer. It should have been

(setq f2 (ssget "x" f1))

or am i wrong?

Ben

 

Rock,
Have you tried ssget "X". In your snippet I can only see SSGET "C".

Ben

 

Hi


Ben Gun wrote;
"That's not LISP, that's a clever programmer. It should have been

(setq f2 (ssget "x" f1))

or am i wrong? "

Yes --- first of all the code do not suggest a solution to the zooming
request ,true it is intelligent programming but Lisp is that, Lisp is
not the "command" scripts but refining the code so it yield exactly
what is described. Maby the Ssget "X" can produce that number of
entities that meet these criteria and travel the entity database by
evaluating the Ssget list if you could put in rules of max x min y min
y and max y --- it's years since I for real executed Lisp as that, but
yes in Lisp this work with the , I guess originally Lisp function
Ssget. Anyway the attitude with Lisp is to describe the solution and
that way get the result ,so if Ssget will not allow for recursive
functions in the Ssget list, then a "new" SSSget function could easily
travel the entity database for points ruled out being within or outside
a cirtain "window" , what's a window other than two sets of points.

 

This routine does use the SSGET "X" however it is still filtering on
entitiy codes. I am searcing for a way to use SSGET "X" and then
specify a pickbox with lower left and upper right coordinates and find
all the entites intersected by the box.

The reason for doing this is because all SSGET options except the "X"
are zoom dependent (please correct me if I am wrong) and I need a zoom
Independent solution.

Thanks,

Rock