;; Hatch Select Criteria - HSC
;; Select Hatches with Equal, Smaller or Larger Area than specified by user
;; Created by ronjonp
;; Saved from https://www.theswamp.org/index.php?topic=53620.0

(defun c:hsc (/ a b fuzz e o s)
(sssetfirst nil nil)
(or *global* (setq *global* "Equal"))
;; Change this number to suit for equality check
(setq fuzz 0.1)
(if
(and
(setq e (car (entsel "\nPick a hatch to get area: ")))
(= 'real (type (setq a (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object e))))))
(not (initget "Equal Smaller Larger"))
(or (setq *global* (getkword (strcat "\nSpecify [Equal/Smaller/Larger] : ")))
*global*
)
(setq s (ssget '((0 . "hatch"))))
)
(progn
(foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
(setq o (eval (cdr (assoc *global* '(("Equal" . equal) ("Smaller" . ))))))
(if (= 'real
(type (setq b (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object x)))))
)
(if (null (cond ((= o equal) (o b a fuzz))
((and (o b a) (not (equal b a fuzz))))
)
)
(ssdel x s)
)
(ssdel x s)
)
)
(sssetfirst nil s)
)
)
(princ)
)
(vl-load-com)
(c:hsc)

Advertisements