AutoCAD 2022: A lisp file that can identify hatches that fail to have “cumulative area”,

[JamaL9722060]

AutoCAD 2022: A lisp file that can identify hatches that fail to have “cumulative area”,

For example, in the screenshot below, some of the hatches fail to have accumulative. I would appreciate if experts can share a lisp file that can identify these hatches

Thank you

[john.uhden]

@JamaL9722060 

When hatches have boundaries that touch (and maybe overlap) themsleves, AutoCAD fails to compute an area, so it doesn't provide an area property.  I could write a routine that highlights (selects) any hatch of such condition, but I don't have a newer release at home and have responsibilities at work.  Someone here will surely jump in to help you out.

Meanwhile, just grip a suspected hatch and see if an area shows up in its properties display.  Maybe you will notice the interference and can just grip/move a vertex over a little.  It doesn't need to be associative, in fact it's better if not IMHO.

[hosneyalaa]

Hi , please Attached example drawing

[JamaL9722060]

I would appreciate if you could share the lisp file. It appears that it’s not attached

Thank you

[hosneyalaa]

HI

TRY

(Defun c:TESST ( / ALIST AREA_ E HTCH I INT_POINT SS TS VEXS)
  (vl-load-com)
  
  (if
    (setq ss (ssget '((0 . "Hatch"))))
    (progn
      (repeat (setq i (sslength ss))
	(setq e (vlax-ename->vla-object (setq htch(ssname ss (Setq i (1- i))))))
	(setq alist (entget htch))
	(if alist
	  (progn
	    (setq vexs (reverse (cdr
				  (reverse (cdr
					     (mapcar 'cdr (vl-remove-if-not
							    (function (lambda (x)(= (car x) 10)))
							    alist)))))))
	    
	    
	    )
	  )
	(IF
	  (not
	    (vl-catch-all-error-p
	      (setq area_ (vl-catch-all-apply 'vla-get-area (list E)))
	      )
	    )
	  (progn (entmakex (list (cons 0 "TEXT")
				 (cons 10  (car vexs))
				 (cons 40 (* 4 (setq ts(getvar "textsize"))))
				 (cons 41 1)
				 (cons 1  (RTOS area_ 2 2 )))))
	  (progn (entmakex (list (cons 0 "TEXT")
				 (cons 10  (car vexs))
				 (cons 40 (* 4 (setq ts(getvar "textsize"))))
				 (cons 41 1)
				 (cons 1  "CHECK_AREA "))))
	  )
	
	
	);;repeat
      
      )
    
    
    )
  (princ)
  )

[john.uhden · Accepted solution]

@JamaL9722060 

Try this.  It won't fix anything, but will report and show you any bad hatches in Modelspace.

(defun c:badhatch ( / *error* vars vals ss i e obj area bad n)
  ;; John F. Uhden, Sea Girt, NJ, USA
  ;; Program finds and selects with cold grips
  ;; all hatches that have no area
  ;; v1.0 (3-30-22)
  (gc)
  (vl-load-com)
  (princ "\nBADHATCH v1.0 (c)2022, John F. Uhden")
  (defun *error* (error)
    (mapcar 'setvar vars vals)
    (vla-endundomark *doc*)
    (cond
      ((not error))
      ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
      (1 (princ (strcat "\nERROR: " error)))
    )
    (princ)
  )
  (setq vars '(cmdecho))
  (setq vals (mapcar 'getvar vars))
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
  (vla-endundomark *doc*)
  (vla-startundomark *doc*)
  (mapcar 'setvar vars '(0))
  (command "_.expert" (getvar "expert")) ;; dummy command
  (if (setq ss (ssget "x" '((0 . "hatch")(410 . "Model"))))
    (progn
      (setq bad (ssadd))
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (setq obj (vlax-ename->vla-object e))
        (setq area (vl-catch-all-apply 'vlax-get (list obj 'area)))
        (if (vl-catch-all-error-p area)
          (ssadd e bad)
        )
      )
      (if (> (setq n (sslength bad)) 0)
        (progn
          (sssetfirst nil bad)
          (alert (strcat "Found " (itoa n) " bad hatch(es)."))
        )
        (prompt "\nFound no bad hatches.")
      )
    )
    (prompt "\nThere are no hatch objects in ModelSpace.")
  )
  (*error* nil)
)

[JamaL9722060]

Both works fine for me. Thank you very much for the help

[JamaL9722060]

I would appreciate John if you could further develop the lisp file so that one can select which portion of the drawing one needs to identify the hatches with no cumulative areas

For example, in the file attached, the machines gets sluggish after applying the command

[john.uhden]

@JamaL9722060 

Just change

(if (setq ss (ssget "x" '((0 . "hatch")(410 . "Model"))))

to

(if (setq ss (ssget '((0 . "hatch"))))

[JamaL9722060]

It works fine. Thank you for the prompt help and time