Select objects inside hatch area

Select objects inside hatch area

prgmdl
Contributor Contributor
5,002 Views
22 Replies
Message 1 of 23

Select objects inside hatch area

prgmdl
Contributor
Contributor

Is there a way to use a hatch to select objects that are inside its boundary? I have an irregular shape of hatch that has multiple holes and was wondering if I can use it as a selection mode for objects (lines, arc, points) inside that hatched areas.

0 Likes
Accepted solutions (1)
5,003 Views
22 Replies
Replies (22)
Message 21 of 23

prgmdl
Contributor
Contributor

I couldn't make the latter two work, the first one is working fine for me. What are the differences between @where @Anonymous_node @place_circle?

0 Likes
Message 22 of 23

john.uhden
Mentor
Mentor
@Anonymous_Node creates a $NODE$ block to use in place of a POINT. I
accidentally left it as a local in #3, where it should have
been @Anonymous_Circle, which does the same thing.
I am confused by why #2 and #3 didn't work for you. I couldn't get #2 to
work correctly as it selected everything in the (ssget "C"), but it
shouldn't have. But #2 and #3 use exactly the same technique, so it
doesn't make sense, unless there is some AutoCAD setting or something that
is screwing up the intersectwith method.
I like #3 the best, but if it's not reliable, then yes, stick with the
original.

John F. Uhden

0 Likes
Message 23 of 23

john.uhden
Mentor
Mentor

If the problem was that PDSIZE=0.0, then here's the fix...

(defun @SSINHATCH3 ( / *error* Doc vars vals @where @Anonymous_node @place_circle pdsize
                       filter circle okay hatch copy LL UR ss obj e p etype)
  ;; Program attempts to create a selection set of objects within a hatched area
  ;;   excluding objects that lie within holes in the hatch.
  ;; This version uses the technique of copying the hatch to a tight ANSI37 pattern,
  ;;   creating a preliminary selection set of all objects included in the filter within the
  ;;   hatch's bounding box and testing if they intersect with the copy.
  ;;   BTW, it appears that at a scale of 1.0 the spacing of ANSI37 is 8.0.
  ;;   Thus the scale of the copied hatch is adjusted to 8 * PDSIZE.
  ;; AutoCAD points are cloned with a circle that can be intersected.
  ;;   The circles are sized equal to PDSIZE on the presumption that the user percieves
  ;;   each POINT object as occupying what appears based on PDMODE and PDSIZE.
  ;; The idea of creating one (1) circle and moving it around is that it leaves just
  ;;   one circle to clean up (vla-delete) at the end of the program.
  ;;   Plus, it's probably faster than repeatedly creating a circle.
  ;; Any entity that intersects with the copy is included in the final selection set.
  ;; The original points are added if their corresponding circle intersects.
  ;; The reason for using a copy of the hatch is that it can be deleted without a (command),
  ;;   whereas restoring the hatch pattern and scale requires the HATCHEDIT command,
  ;;   which might not work within an *error* function.
  ;; NOTE that the initial selection set is processed backwards, from the last to the first.
  ;;   The reason is that if an enity is deleted from the set, it doesn't alter the order
  ;;   of those entities that come before it in the set, and the counter will never exceed
  ;;   the length of the set.
  ;; Unless I am mistaken, the (ssget "C") takes longer than all the (vla-intersectwith)s.
  ;;   I'd like to find a way to speed it up, but it's fairly quick anyway, so nevermind.
  (gc)
  (vl-load-com)
  (prompt "\nSSINHATCH3.lsp v1.0 (c)2021, John F. Uhden")
  (defun *error* (err)
    (if (= (type circle) 'VLA-OBJECT)(vla-delete circle))
    (if (= (type copy) 'VLA-OBJECT)(vla-delete copy))
    (vlax-invoke Doc 'regen 1)
    (if ss
      (progn
        (sssetfirst nil ss)
        (princ (strcat "\n  Selected " (itoa (sslength ss)) " entities."))
      )
    )
    (mapcar 'setvar vars vals)
    (vla-endundomark Doc)
    (cond
      ((not err))
      ((wcmatch (strcase err) "*CANCEL*,*QUIT*")
         (vl-exit-with-error "\r                                              ")
      )
      (1 (vl-exit-with-error (strcat "\r*ERROR*: " err)))
    )
    (princ)
  )
  ;;----------------------------------------
  ;; Initialize
  ;;
  (setq Doc (vlax-get (vlax-get-acad-object) 'ActiveDocument))
  (vla-endundomark Doc)
  (vla-startundomark Doc)
  (setq vars '("cmdecho" "dimzin" "highlight"))
  (setq vals (mapcar 'getvar vars))
  (mapcar 'setvar vars '(0 1 0))
  (setq pdsize (max 0.02 (getvar "pdsize"))) ;; added max (07-14-21) to compensate when PDSIZE=0.0

  (defun @where ()
    (if (> (getvar "cvport") 1)
      (cons 410 "Model")
      (cons 410 (getvar "ctab"))
    )
  )
  (defun @Anonymous_circle ( / e)
    (setq e
      (entmakex
        (list '(0 . "CIRCLE") '(8 . "0") '(10 0.0 0.0 0.0) '(210 0.0 0.0 1.0) '(40 . 0.5) (@where) '(60 . 1) '(62 . 0))
      )
      circle (vlax-ename->vla-object e)
    )
  )
  ;; Function to reposition the circle to where a point is:
  (defun @place_circle (e / p)
    (if (/= (type circle) 'VLA-OBJECT)(@make_circle))
    (setq p (cdr (assoc 10 (entget e))))
    (vlax-put circle 'Center p)
    circle
  )
  ;; Begin the action:
  (while (not okay)
    (setq hatch (car (entsel "\nSelect a Hatch: ")))
    (if (= (cdr (assoc 0 (entget hatch))) "HATCH")
      (setq okay 1)
      (prompt "\n  Object selected is not a hatch.  Pick again...")
    )
  )
  (vla-getboundingbox (vlax-ename->vla-object hatch) 'LL 'UR)
  (setq LL (vlax-safearray->list LL) UR (vlax-safearray->list UR))
  (setq filter (getstring "\nEnter object types (e.g. \"ARC,LINE,INSERT,POINT,*TEXT\") <*>: "))
  (if (= filter "")(setq filter "*"))
  (setq ss (ssdel hatch (ssget "C" LL UR (list (cons 0 filter)))))
  (setq copy (vla-copy (vlax-ename->vla-object hatch)))
  (vl-cmdf ".hatchedit" (vlax-vla-object->ename copy) "_P" "ANSI37" (* 8.0 pdsize) "")
  (repeat (setq i (sslength ss))
    (setq e (ssname ss (setq i (1- i)))
          etype (cdr (assoc 0 (entget e)))
    )
    (if (= etype "POINT")
      (setq obj (@place_circle e))
      (setq obj (vlax-ename->vla-object e))
    )
    (if (not (vlax-invoke copy 'intersectwith obj 0))
      (ssdel e ss)
    )
  )
  (*error* nil)
)

John F. Uhden

0 Likes