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