SSGET Crossing using SSGET "X"

Discussion in 'AutoCAD' started by MrRockDoc, Nov 11, 2005.

  1. MrRockDoc

    MrRockDoc Guest

    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)
    )
     
    MrRockDoc, Nov 11, 2005
    #1
    1. Advertisements

  2. MrRockDoc

    Mr. B Guest

    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, Nov 11, 2005
    #2
    1. Advertisements

  3. MrRockDoc

    MrRockDoc Guest

    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
     
    MrRockDoc, Nov 11, 2005
    #3
  4. MrRockDoc

    Rock Guest

    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, Nov 13, 2005
    #4
  5. MrRockDoc

    R.K. McSwain Guest

    Rock said the following on 11/13/2005 1:23 PM:
    Your dealer
    ADN network
    Autodesk discussion groups
    AUGI forums
    CADTutor forums
     
    R.K. McSwain, Nov 14, 2005
    #5
  6. MrRockDoc

    R. Wink Guest

    This being the first time I've seen your message, I have to ask what you're try to do?
    R. Wink
     
    R. Wink, Nov 14, 2005
    #6
  7. MrRockDoc

    per.corell Guest

    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.
     
    per.corell, Nov 14, 2005
    #7
  8. MrRockDoc

    Rock Guest

    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)
    )
     
    Rock, Nov 14, 2005
    #8
  9. MrRockDoc

    R. Wink Guest

    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)))
    )
     
    R. Wink, Nov 15, 2005
    #9
  10. MrRockDoc

    per.corell Guest

    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 ;))
     
    per.corell, Nov 15, 2005
    #10
  11. MrRockDoc

    Ben Gun Guest

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

    (setq f2 (ssget "x" f1))

    or am i wrong?

    Ben
     
    Ben Gun, Nov 15, 2005
    #11
  12. MrRockDoc

    Ben Gun Guest

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

    Ben
     
    Ben Gun, Nov 15, 2005
    #12
  13. MrRockDoc

    per.corell Guest

    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.
     
    per.corell, Nov 15, 2005
    #13
  14. MrRockDoc

    Rock Guest

    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
     
    Rock, Nov 15, 2005
    #14
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.