Lisp to select polylines wihout hatch?

Lisp to select polylines wihout hatch?

Anonymous
Not applicable
814 Views
3 Replies
Message 1 of 4

Lisp to select polylines wihout hatch?

Anonymous
Not applicable

Hello,

 

Is there a way to select all closed polylines in a drawing that have no hatches (non associative) in them?

 

Thanks!

0 Likes
815 Views
3 Replies
Replies (3)
Message 2 of 4

dbhunia
Advisor
Advisor

Try this.....

 

(defun C:SPOL (/ sset N ent ptlst)
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq sset (ssget "_A" '((0 . "LWPOLYLINE") (70 . 1))))
(repeat (setq N (sslength sset))
	(setq ent (ssname sset (setq N (- N 1)))
	      ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget ent)))
   	)
	(if (/= nil (setq ss (ssget "_CP" ptlst '((0 . "HATCH") (71 . 1)))))
	    (progn
		(ssdel ent sset)
	    )	
	)
)
(sssetfirst nil sset)
(setvar 'cmdecho cmd)
(princ)
)

Debashis Bhunia
Co-Founder of Geometrifying Trigonometry(C)
________________________________________________
Walking is the First step of Running, Technique comes Next....
Message 3 of 4

ВeekeeCZ
Consultant
Consultant

First of all, a polyline can be associated with more than one HATCH. Also could be just partially associated. 

So the routine checks the number of associated HATCHs and if the AREA of both PL and HATCH is same, then is excluded from the selection set.

 

(vl-load-com)

(defun c:SelectPolyNoHatch ( / ss i en lst obj ar1 ar2)
  
  (if (setq ss (ssget "_X" (list '(0 . "LWPOLYLINE") '(-4 . "&=") '(70 . 1) (cons 410 (getvar 'CTAB)))))
    (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i))))
      (if (and (setq lst (vl-remove-if-not (function (lambda (x) (and (= 330 (car x)) (= "HATCH" (cdr (assoc 0 (entget (cdr x)))))))) (entget en)))
	       (= 1 (length lst))
	       (setq obj (vlax-ename->vla-object (cdar lst)))
	       (not (vl-catch-all-error-p (setq ar1 (vl-catch-all-apply 'vla-get-area (list obj)))))
	       (setq obj (vlax-ename->vla-object en))
	       (not (vl-catch-all-error-p (setq ar2 (vl-catch-all-apply 'vla-get-area (list obj)))))
	       (equal ar1 ar2 1e-6))
	(ssdel en ss))))
  (if (and ss (> (sslength ss) 0))
    (sssetfirst nil ss))
  (princ)
  )
Message 4 of 4

Anonymous
Not applicable

Both methods worked in my case, thank you all.

0 Likes