Select objects inside hatch area

[prgmdl]

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.

[fkellogg]

DOES THIS HELP?

[prgmdl]

I also need to select points object that are inside the hatch area.

[john.uhden]

I was thinking that you could use -HATCHEDIT;B to create the closed polyline boundary, then

use (vlax-curve-getpointatdist plineobj ...) to build a tight list of points (ptlist) along the boundary path, then

use (setq ss (ssget "_WP" ptlist filter)) to get objects totally inside the boundary, but

maybe you want to include lines and arcs that are half in and half out, so

use (setq ss (ssget "_CP" ptlist filter)) to get objects crossed by the boundary or within it.

NOTE that it's not a perfect solution because the ptlist is really only an approximation of the boundary, but

if the polyline boundary has no arced segments, then you can use just the vertex points and ptlist will be exact.

We've been through this inside/outside thing a gazillion times.  I finally wrote one that absolutely works, but it's kinda tedious involving the creation of a region from a polyline and then deleting it for every point being inspected.

Plus, there is the user's perspective of whether a point ON the boundary is inside or outside.

[Kent1Cooper]

---

@prgmdl wrote:

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

---

And do I assume correctly that any objects that are inside one of the multiple holes should not be selected, because they are not within the Hatched area [even though they are within its outer perimeter]?

@john.uhden, how would a boundary-as-WP-or-CP approach deal with holes in the Hatch pattern?  I assume there would need to be a selection of things within the outer perimeter [which would include things inside the holes], and separate selections of things within the perimeters of the holes, to be removed from the larger selection.  And the perimeters of the holes themselves should also be removed, if reconstructed.  @prgmdl, if the Hatch boundary pieces are already present and you don't need to reconstruct the boundary, should those pieces that define the holes be included in or omitted from the selection of what's inside?

[john.uhden]

Hi, @Kent1Cooper .

I'm tempted to just write the thing, but I like explaining it first so I can tell if I know what I'm talking about first.

   ;;----------------------------------------
   ;; Function to get absolutely last entity:
   ;;
   (defun @entlast ( / elast e)
     (setq elast (entlast))
     (while (setq e (entnext elast))
       (setq elast e)
     )
     elast
   )

1.  (setq e (@entlast))

2.  -Hatchedit the hatch and recreate the boundaries (which will include the holes), and do NOT associate.

3. Create a selection set of the boundaries...
(setq ss (ssadd))
(while (setq e (entnext e))
  (ssadd e ss)
)

4.  Iterate through ss and determine the outer boundary, probably by its area, and call it 'outer.

5.  Create a selection set of the holes...

(setq holes (ssdel outer ss))

6.  Create a point list ("ptlist") of the outer using a custom function that adds tight points along bulged segments.
     We can call it @complexify.

7.  Use the point list and a filter of choice to...

(setq ssouter (ssget "_CP" ptlist filter))

8.  For each of the holes, do steps #6 and #7 on the hole, deleting any of its selection from ssouter.

9.  Done.  Except for @complexify, it's all pretty easy.

Now remember, it won't be exact because of all the pitfalls we surmised with the @inside discussions, but I doubt anyone will take the user to court.  Anyway, he could...

(command "_.select" ssouter pause)

to add/remove anything he thinks should/shouldn't be selected.

You could also try using 'intersectwith the hatch, but the hatch pattern would have to be really tight because solid hatches are "not acceptable."

[john.uhden]

I was just thinking...

The vla-intersectwith method could work perfectly if the hatch pattern were temporarily changed to a tight ANSI37.

The only problem would be points, that take up no space at all.  But they could be cloned into a NODE block and create an association list between the point and the NODE.  After the selection set (or list) is created, delete the associated points and all the NODEs.

The only problem with that is if the NODE block were big enough to intersect but its insertion point were outside.  Then again, if the user considered the POINT based on its appearance via PDMODE and PDSIZE, then a NODE of same size and shape would be a perfect representation.

[prgmdl]

Yes, something like an intersect command, where any object that collides in the hatch area will be selected.

[Kent1Cooper]

---

@prgmdl wrote:

Yes, something like an intersect command, where any object that collides in the hatch area will be selected.

---

Including something that extends beyond the Hatch area in one or both directions?  Or something that is fully within the outer Hatch boundary but crosses through a hole, and is therefore not really fully inside the Hatch area?  I expect differentiating those from things fully within will be a challenge, but it may be possible.

[prgmdl]

Only objects that are bounded inside the hatched area, excluding any lines/arcs that are extending beyond it. If it would make things easier, I am just particular with selecting point objects, since I've got thousands of it, compared to the arcs/lines that I can individually select. The shape of the hatch area is an irregular network of pathways that have multiple crossings, and only the points that are inside these hatched pathways I wanted to select.

[pbejse]

---

@prgmdl wrote:

 The shape of the hatch area is an irregular network of pathways that have multiple crossings, and only the points that are inside these hatched pathways I wanted to select.

---

Disclosing the target objects as point entity helps a lot, I think its time that you post a sample drawing with the irregular shape hatch with holes that your keep referring to. 

[Sea-Haven]

Without a test dwg this is a bit of a guess but works on what I tested,

; objects within a hatch
; by AlanH june 2021

(defun c:test ( / ent x lst lst2 )
	(setq ent (entget (car (entsel "Pick hatch "))))
	
	(setq x 0  lst '() stop "No")
	
	(repeat (length ent)
		(if (and (= (car (nth x ent)) 10)(/= stop "yes"))
		(if (= (cadr (nth x ent)) (list 0.0 0.0 0.0))
			(princ)
			(setq lst (cons (cdr (nth x ent)) lst))
		)
		)
		(setq x (+ x 1))
		(princ x)
		(if (= (car (nth x ent)) 97)
			(setq lst2 lst stop "yes")
		)
	)
	(setq lst2 (subst (nth 0 lst) (list 0.0 0.0 0.0) lst2))
	
	(setq ss (ssget "WP" lst2 '((0 . "POINT"))))
	
	(alert (strcat "You have " (rtos (sslength ss) 2 0) "  Points "))
(princ)
)

(c:test)

[prgmdl]

I tried to run this but it is selecting the points inside the holes that doesn't have a hatch area. But it still works and could help a lot. Thanks

[prgmdl]

Sorry I couldn't provide a cad file but could this screenshot help?

Basically all objects are in a default layer and are flat at 0 elevation. The 'x' marks are the points I want to select and the hatch with holes is this gray intersections.

[john.uhden]

Be patient. I'm working on it.
;; Program attempts to create a selection set of objects within a hatched
area
;; excluding objects that lie within holes in the hatch.
;; Using either option of CrossingPolygon or WindowPolygon, it refines
the boundaries
;; by adding points where they are curved. Refinement options are
Tight/Very/Super/Ultra.

[john.uhden · Accepted solution]

Here's my first stab at it.

Careful trying "Ultra" tightness if you are impatient.

(defun @SSINHATCH ( / *error* Doc vars vals @Anonymous @entlast @Anonymous @Anonymous @tighten @ss2list
                  polytype ans filter tightness e elast okay bounds ss outer holes)
  ;; Program attempts to create a selection set of objects within a hatched area
  ;; excluding objects that lie within holes in the hatch.
  ;; Using either option of CrossingPolygon or WindowPolygon, it refines the boundaries
  ;; by adding points where they are curved.  Refinement options are Tight/Very/Super/Ultra.
  (gc)
  (vl-load-com)
  (prompt "\nSSINHATCH.lsp v1.0 (c)2021, John F. Uhden")
  (defun *error* (err)
    (mapcar 'setvar vars vals)
    (mapcar 'entdel bounds)
    (vlax-invoke Doc 'regen 1)
    (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))
  (command "_.expert" (getvar "expert")) ;; dummy command

  (defun @Anonymous (p)(list (car p)(cadr p)))

  ;; Function to get the absolute last entity in the database:
  (defun @entlast ( / e elast)
    (setq elast (entlast))
    (while (setq e (entnext elast))(setq elast e))
    elast
  )

  ;; Function to return the area of an entity:
  (defun @Anonymous (e)
    (vlax-get (vlax-ename->vla-object e) 'Area)
  )

  ;; Function to return LWpolyline data in the format...
  ;; '((b1 x1 y1)(b2 x2 y2) ... (bn xn yn))
  (defun @Anonymous (E / obj plist blist)
    (setq ent (entget e) obj (vlax-ename->vla-object e))
    (setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x)(= (car x) 10)) ent)))
    (setq blist (mapcar 'cdr (vl-remove-if-not '(lambda (x)(= (car x) 42)) ent)))
    (setq plist (mapcar 'cons blist plist))
    ;; polyline is supposed to be closed, so...
    (cons obj (append plist (list (car plist))))
  )

  ;; Function to convert a selection set into a list of enames:
  (defun @ss2list (ss / i lst)
    (repeat (setq i (sslength ss))
      (setq lst (cons (ssname ss (setq i (1- i))) lst))
    )
    lst
  )
  (defun @tighten (old / i bulge p1 p2 d1 d2 p d n new)
  ;; where old is LWpolyline data in the format...
  ;; '(e (b1 x1 y1)(b2 x2 y2) ... (bn xn yn))
    (setq i 0 e (car old) old (cdr old))
    (while (< i (1- (length old)))
      (setq p1 (nth i old)
            bulge (car p1)
            p1 (cdr p1)
	     i (1+ i)
	    p2 (cdr (nth i old))
            new (cons p1 new)
      )
      (if (/= bulge 0.0)
        (progn
          (setq d1 (vlax-curve-getdistatpoint e p1)
                d2 (vlax-curve-getdistatpoint e p2)
                d (- d2 d1)
                n (1+ (fix (/ d (abs (/ tightness bulge)))))
                ;; based on the theory that a smaller bulge needs fewer points
                dd (/ d n)
                d d1
                add nil
          )
          (repeat (1- n)
            (setq d (+ d dd)
                  p (@2d (vlax-curve-getpointatdist e d))
                  new (cons p new)
            )
          )
        )
      )
    )
    (reverse (cons p2 new))
  )
  (initget "Crossing Window")
  (setq polytype (getkword "\nPolygon type, <Crossing>/window: "))
  (if (= polytype "Window")(setq polytype "_WP")(setq polytype "_CP"))
  (initget 1 "Tight Very Super Ultra")
  (setq ans (getkword "\nTightness around curves, Tight/Very/Super/Ultra: "))
  (setq tightness (cdr (assoc ans '(("Tight" . 0.1)("Very" . 0.05)("Super" . 0.01)("Ultra" . 0.005)))))
  (setq filter (getstring "\nEnter object types (e.g. \"ARC,LINE,INSERT,*TEXT\") <*>: "))
  (if (= filter "")(setq filter "*"))
  (setq elast (@entlast) okay nil)
  (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...")
    )
  )
  (setq OK 1)
  (command "_.-hatchedit" hatch "_B" "_P" "_N")
  (SETQ OK 2)
  (while (setq e (entnext elast))
    (setq elast e bounds (cons e bounds))
  )
  (SETQ OK 3)
  (setq bounds (vl-sort BOUNDS '(lambda (a b)(> (@area a)(@area b)))))
  (SETQ OK 4)
  (setq outer (car bounds) holes (cdr bounds))
  (SETQ OK 5)
  (setq ss (ssget polytype (@tighten (@plist outer)) (list (cons 0 filter))))
  (ssdel hatch ss)
  (SETQ OK 6)
  (foreach hole holes
    (setq sshole (ssget polytype (@tighten (@plist hole)) (list (cons 0 filter))))
    (ssdel hatch sshole)
    (foreach e (@ss2list sshole)(ssdel e ss))
  )
  (SETQ OK 7)
  (princ (strcat "\n  Selected " (itoa (sslength ss)) " entities."))
  (SETQ OK 8)
  (sssetfirst nil ss)
  (SETQ OK 9)
  (*error* nil)
)

[prgmdl]

It is almost doing the selection perfectly but there are some points that are being selected even outside the hatched area. I used window option and up to super yet it selects near points that are not intersected by the hatch. Anyway this is the best solution I can use for now. Thanks so much

[john.uhden]

That could possibly happen if there is an arced segment protruding inward.
I've been thinking of writing the intersectwith version. It's all clear in
my head; just have to put it to music.

[john.uhden]

Here's my second attempt which uses the intersectwith method.

It runs great, but it doesn't work correctly and I haven't figured out why.

Actually I had it working and then decided to "improve" it.

No, I didn't keep a copy of the working version.

(defun @SSINHATCH2 ( / *error* Doc vars vals @where @Anonymous_node @place_node pdsize
                       filter nodeobj 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 NODE blocks that contain a circle that can be intersected.
  ;;   The node blocks are scaled equal to PDSIZE on the presumption that the user percieves
  ;;   each POINT object as occupying what appears based on PDMODE and PDSIZE.
  ;; Any entity that intersects with the copy is included in the final selection set.
  ;; The original points are added if their corresponding NODE 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.
  ;; 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 "\nSSINHATCH2.lsp v1.0 (c)2021, John F. Uhden")
  (defun *error* (err)
    (if (= (type nodeobj) 'VLA-OBJECT)(vla-delete nodeobj))
    (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 (getvar "pdsize"))

  (defun @where ()
    (if (> (getvar "cvport") 1)
      (cons 410 "Model")
      (cons 410 (getvar "ctab"))
    )
  )
  (defun @Anonymous_node ()
    (and
      (not (tblsearch "block" "$NODE$"))
      (entmake
       '((0 . "BLOCK") (2 . "$NODE$") (70 . 2) (10 0.0 0.0 0.0))
      )
      (entmake
       '((0 . "CIRCLE") (8 . "0") (10 0.0 0.0 0.0) (210 0.0 0.0 1.0) (40 . 0.5) (62 . 0))
      )
      (entmake '((0 . "ENDBLK")))
    )
    (or
      (setq nodeobj (vlax-ename->vla-object (ssname (ssget "x" (list '(0 . "INSERT")'(2 . "$NODE$")(@where))) 0)))
      (setq nodeobj (vlax-ename->vla-object (entmakex (list '(0 . "INSERT")'(2 . "$NODE$")'(10 0.0 0.0 0.0)(cons 41 pdsize)(cons 42 pdsize)(cons 43 pdsize)(@where)'(60 . 1)))))
    )
  )
  ;; Function to reposition the nodeobj to where a point is:
  (defun @place_node (e / p)
    (if (/= (type nodeobj) 'VLA-OBJECT)(@make_node))
    (setq p (cdr (assoc 10 (entget e))))
    (vlax-put nodeobj 'InsertionPoint p)
    nodeobj
  )
  ;; 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_node e))
      (setq obj (vlax-ename->vla-object e))
    )
    (if (not (vlax-invoke copy 'intersectwith obj 0))
      (ssdel e ss)
    )
  )
  (*error* nil)
)

[john.uhden]

Ahah!

I guess the intersectwith method gets confused with block insertions.

So I changed the point conversion to a simple circle (which I should have used in the first place),

and now it works perfectly, holes and all...

(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 (getvar "pdsize"))

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