Find Hatch without area, hatch with error

[César Petersen]

Hello!

 

I often need to count areas with hatches, using the cumulative area property.

And many times, we get bad hatches without area, needing to painstakingly go one by one finding the bad hatch to fix it, sometimes repeating for multiple hatches

I tried to find a LISP routine for that without sucess, so i made my own and i'd like to share

 

It loops over the selected hatches, accumulating the bad ones on an empty selection set, highlighting it afterwards.

 

The only little thing bothering me is the (sssetfirst nil serr) function, that highlights the set, sometimes it need an extra click on the screen to show the grips, i tried putting a 

(command "_REGEN") and (princ) after, without much sucess.

 

I hope it's useful!

findBadHatches.lsp

[mhupp]

Updated the code a bit. Using foreach rather than the i methed. (cleaner I think)

But i don't think that was the cause maybe "(sssetfirst nil nil)" and the princ after cant say for sure those wern't needed  so i commented them out.

 

Also updated the area display to show up as

Total Area: 30.5610 sq. in (0.2122 sq. ft)

rather then

Total Area: "30.5610 sq. in (0.2122 sq. ft)"

 

Hope this helps didn't have a drawing to test it on.

 

;; Select hatches without area property
(defun c:HAREA (/ sset serr area)
  (setq serr (ssadd)) ; Empty selection for the bad hatches
  (if (>= (atof (substr (getvar "acadver") 1 4)) 16.2)  ; checks version ;why?
    (if (setq sset (ssget '((0 . "hatch"))))      ; select the hatches
      (progn
        (setq area 0.0)
        (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))  ;steps thought selection set without i
          (setq a (vl-catch-all-apply '(lambda () (vla-get-area (vlax-ename->vla-object ent)))))  ; gets the hatch area or error
          (if (vl-catch-all-error-p a)  ; captures the error
            (ssadd ent serr) ; adds the bad hatch to the selections
            (setq area (+ area a))  ; or else, sums the area
          )
        )
        (if (> (sslength serr) 0) ; Highligths the bad hatches or informs the total area
          (progn
            (prompt "\nBad Hatches Highlighed")  
            ;removed (princ "\nMIGHT NEED TO CLICK AGAIN TO SHOW THE GRIPS")
            ;removed (sssetfirst nil nil)
            (sssetfirst nil serr) ; Highlights the bad hatches
            ;removed (princ)
          )
          (progn  ; infroms the total area of hatches
            (if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4))
              (prompt (strcat "\nTotal Area: " (rtos area 2) " sq. in (" (rtos (/ area 144) 2) " sq. ft)"))
              (prompt (strcat "\nTotal Area: " (rtos area)))
            )
          )
        )
      )
    )
  )
  (princ)
)

 

if your still getting an error maybe flip the serr if statement.

 

        (if (= (sslength serr) 0)
          (progn
            (if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4))
              (prompt (strcat "\nTotal Area: " (rtos area 2) " sq. in (" (rtos (/ area 144) 2) " sq. ft)"))
              (prompt (strcat "\nTotal Area: " (rtos area)))
            )
          )
          (progn
            (prompt "\nBad Hatches Highlighed")
            ;removed (princ "\nMIGHT NEED TO CLICK AGAIN TO SHOW THE GRIPS")
            ;removed (sssetfirst nil nil)
            ; Highlights the selection
            (sssetfirst nil serr)
            ;removed (princ)
          )
        )

 

Also use the \n at the start of a princ, prompt that might have been causing your click error. i think it acts like having an extra "" in the (command

[ronjonp]

@César Petersen Nice job .. here's another way to visually see 'bad' hatches:

;; Author: Cesar Eduardo Petersen (2021) - cesar.e.p@hotmail.com
;; Select hatches without area property

(defun c:harea (/ a area bad ent good i sset) ; Empty selection for the bad hatches
					; checks version
  (if (>= (atof (substr (getvar "acadver") 1 4)) 16.2) ; select the hatches
    (if	(setq sset (ssget '((0 . "hatch"))))
      (progn (setq area 0.0)		; itera pelo numero de hatchs
	     (repeat (setq i (sslength sset))
	       (progn			; gets the entity
		 (setq ent (ssname sset (setq i (1- i)))) ; gets the hatch area or error
		 (setq a (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object ent))))
					; captures the error
		 (if (= 'real (type a))	; adds the bad hatch to the selections
		   ;; RJP - added two lists to process if bad hatches are found
		   (progn (setq area (+ area a)) (setq good (cons ent good)))
		   (setq bad (cons ent bad))
		 )
	       )
	     )				; Highligths the bad hatches or informs the total area
	     (if bad
	       (progn (princ "Bad Hatches Highlighed\n")
		      (princ "MIGHT NEED TO CLICK AGAIN TO SHOW THE GRIPS\n")
		      ;; RJP - Highlight bad 
		      (foreach e bad (redraw e 3))
		      ;; RJP - Hide good ( regen to see again )
		      (foreach e good (redraw e 2))
	       )
	       (progn (princ "\nTotal Area: ")
		      ;; RJP - simplified OR check
		      (if (> (getvar 'lunits) 2)
			(strcat (rtos area 2) " sq. in. (" (rtos (/ area 144) 2) " sq. ft.)")
			(rtos area)
		      )
	       )
	     )
      )
    )
  )
  ;; SHHHHHH
  (princ)
)

 

[mhupp]

would this work @ronjonp ? I don't know how to create a hatch that doesn't have area to test it.

 

(if (setq a (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object ent))))
  (setq area (+ area a)
        good (cons ent good)
  )
  (setq bad (cons ent bad))
)

 

[ronjonp]

19 hours ago, mhupp said:

would this work @ronjonp ? I don't know how to create a hatch that doesn't have area to test it.

 

(if (setq a (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object ent))))
  (setq area (+ area a)
        good (cons ent good)
  )
  (setq bad (cons ent bad))
)

 

Sure would  .. I've come to like the shorter format whether right or wrong. I see you've removed the type test .. that will not work.

 

Try something like:

(if (setq a
	   (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object ent))))
    )
  (setq bad (cons ent bad))
  (setq	area (+ area a)
	good (cons ent good)
  )
)

 

Create a self intersecting area then hatch by object to test:

Edited September 17, 2021 by ronjonp

[ronjonp]

@mhupp

You can also check the result type from the vl-catch like so:

(if
  (= 'real (type (setq a (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object ent))))))
   (setq area (+ area a)
	 good (cons ent good)
   )
   (setq bad (cons ent bad))
)

 

[mhupp]

Bricscad wont make a hatch without a area.

[ronjonp]

2 hours ago, mhupp said:

Bricscad wont make a hatch without a area.

Not surprised