Autoselect nearest closed polyline that surrounds text entity

[Tharwat]

Which codes you are referring to?

[grpngy]

this topic helped me very much. But i have a wish to use it more helpfully. I am using this for selecting the building countours by using the floor number text inside the closed polyline. But i have to click each text, i wonder that if it possible to use this code with already selected multiple texts? Because i already have the all texts for example "2" which means all the buildings with two storey. I can select the texts with using filter. After selecting all the text if i can use the code and select all the countours, it will be perfect. Because then i can separete them and export according to floor number to any 3d program for extrude etc...

[grpngy]

help please

[BIGAL]

The codes provided by Grr amd Tharwat both use this method (setq txt (entsel "\nPick text/mtext inside of closed polyline: ")) selecting one entity, using (ssget "P" means use the previous selected entities or you can use SSGET with a filter "TEXT" which would be better. Then use Repeat to carry out the rest of the code for every "Text" Chosen. I am sure Grr or Tharwat will answer.

[grpngy]

sorry

I do not know where to add these rumors

Would you help me where to add it

[grpngy]

please

you can help you

[martinle]

Hello Grrr, one could instead of the text synonymous a hatchau select so that one can grasp the polyline? Would something be realizable? That would be great!

 

Martin

[Grrr]

Hello Grrr, one could instead of the text synonymous a hatchau select so that one can grasp the polyline? Would something be realizable? That would be great!

 

Martin

 

Hi,

This one should filter-out any non-linked hatches with lwpolylines. The link is defined by comparing the centroids and the areas for each polyline/hatch.

 

; Filter Linked Hatches or Polylines
(defun C:test ( / SS i e o enx ll ur c Hs Ps nPs nHs nSS ) 
 
 (cond
   ( (and (princ "\nSelect Hatches with polylines: ") (setq SS (ssget "_:L-I" '((0 . "HATCH,LWPOLYLINE")))))
     (repeat (setq i (sslength SS))
       (setq e (ssname SS (setq i (1- i))))
       (setq o (vlax-ename->vla-object e))
       (setq enx (entget e))
       (vla-GetBoundingBox o 'll 'ur)
       (setq c (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.)) (mapcar 'vlax-safearray->list (list ll ur))))) ; Lee Mac
       (cond ; Compare the area also, just in case
         ( (= "HATCH" (cdr (assoc 0 enx))) (setq Hs (cons (list e c (vla-get-Area o) ) Hs)) )
         ( (setq Ps (cons (list e c (vla-get-Area o) ) Ps )) )
       ); cond
     ); repeat
     (and
       (setq nPs (mapcar 'car (vl-remove-if-not '(lambda (p) (vl-some '(lambda (h) (equal (append (cadr p) (list (caddr p))) (append (cadr h) (list (caddr h))) 1e-1)) Hs)) Ps))) 
       (setq nHs (mapcar 'car (vl-remove-if-not '(lambda (h) (vl-some '(lambda (p) (equal (append (cadr p) (list (caddr p))) (append (cadr h) (list (caddr h))) 1e-1)) Ps)) Hs))) 
       (setq nSS (ssadd))
       (mapcar '(lambda (x) (ssadd x nSS)) 
         (eval (cadr (assoc (progn (initget "Hatches Polylines") (cond ((getkword "\nGrip [Hatches/Polylines] <Hatches>: ")) ("Hatches"))) '(("Hatches" nHs) ("Polylines" nPs)))))
       )
       (sssetfirst nil nSS)
     ); and
   ); SS 
 ); cond
 (princ)
); defun

[martinle]

Hello Grrr, thanks for the quick reply! I will test it on Monday at work and then report it. Thank you!

Martin

[Roy_043]

; (HatchBoundaryList (car (entsel)))
; Return value: List of enames (can contain doubles).
(defun HatchBoundaryList (enm)
 (cdr 
   (vl-remove
     nil
     (mapcar
       '(lambda (sub) (if (= 330 (car sub)) (cdr sub)))
       (entget enm)
     )
   )
 )
)

@Grrr: The equal function also works on 'complex' lists.

[Grrr]

Hi Roy,

Thanks for the input - my comparsion functions could be simplified to:

 

(setq nPs (mapcar 'car (vl-remove-if-not '(lambda (p) (vl-some '(lambda (h) (equal (cdr p) (cdr h) 1e-1)) Hs)) Ps))) 
(setq nHs (mapcar 'car (vl-remove-if-not '(lambda (h) (vl-some '(lambda (p) (equal (cdr p) (cdr h) 1e-1)) Ps)) Hs))) 

 

But overall the method I use works only for "simple" hatches, that do not contain inner or outter loops.

Before writing that code I was wondering how to obtain the objects that define the hatch boundary, well now I know from your HatchBoundaryList subfunction.

And just figured out how to find them with activex (at first look there was no property to obtain those) :

 

; (HatchBoundaryList2 (vlax-ename->vla-object (car (entsel "\nSelect Hatch: "))))
; Returns: List of vla-objects
(defun HatchBoundaryList2 ( o / i L BoundL )
 (setq i 0)
 (while (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-GetLoopAt (list o i 'BoundL))))
   (setq L (cons (safearray-value BoundL) L))
   (setq i (1+ i))
 )
 (setq L (apply 'append L))
)

 

Couldn't avoid the error-trapping loop, maybe someone else did it differently?

 

EDIT: However, thanks to Roy's input this version should work fine:

 

(defun C:test ( / SS i Hs Bs nSS ) 
 
 (defun HatchBoundaryList (enm) ; Roy
   (cdr (vl-remove nil (mapcar '(lambda (sub) (if (= 330 (car sub)) (cdr sub))) (entget enm) ) ) )
 )
 
 (cond
   ( (and (princ "\nSelect Hatches: ") (setq SS (ssget "_:L-I" '((0 . "HATCH")))))
     (repeat (setq i (sslength SS)) (setq Hs (cons (ssname SS (setq i (1- i))) Hs)) )
     (and
       (setq Bs (apply 'append (mapcar 'HatchBoundaryList Hs)))
       (setq nSS (ssadd))
       (progn
         (mapcar '(lambda (x) (ssadd x nSS)) 
           (eval 
             (cadr
               (assoc 
                 (progn (initget "Hatches Boundaries") 
                   (cond ((getkword "\nGrip [Hatches/Boundaries] <Boundaries>: ")) ("Boundaries"))
                 )
                 '(("Hatches" Hs) ("Boundaries" Bs))
               )
             )
           )
         )
         (sssetfirst nil nSS)
       ); progn
     ); and
   ); SS 
 ); cond
 (princ)
); defun 

[Lee Mac]

Couldn't avoid the error-trapping loop, maybe someone else did it differently?

 

vla-get-numberofloops

[Grrr]

vla-get-numberofloops

 

Thanks Lee, now with repeat function it won't give troubles.

[mk4176]

Hi all,

I am trying to modify the following code to delete every polyline enclosing a block of name C1666.

Every polyline has only one block, the rest that don't have a block should not be deleted.

I tried to modify Tharwat's code to serve my purpose, it is working on few polylines, I don't know why it is not deleting all the rest.

I know maybe the code is not so elegant, but I am doing my best to improve with time.

Attached an example drawing.

Any help highly appreciated and thanks in advance.

 (defun c:Test3 ( / blks s ss i e p c_doc lst)
 ;;--------------------------------------------;;
 ;;	Tharwat - Date: 03.Aug.2016		;;
 ;; Auto-select polyline that surrounds	;;
 ;;  		picked text 			;;
 ;;--------------------------------------------;;
 
   (defun *error* ( msg )
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );end_defun
  
   (setq c_doc (vla-get-activedocument (vlax-get-acad-object)))

  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)

		;; All the C1666
		(setq blks (ssget "_x" '((0 . "insert") (2 . "C1666"))))

		(if (= (type blks) 'pickset)
          (setq blks (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex blks)))))
        )

		(foreach e blks
			(setq 
				ss (ssget "_X" (list '(0 . "LWPOLYLINE") '(8 . "C1602_0") '(-4 . "&=") '(70 . 1) (cons 410 (getvar 'CTAB))))
				p (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint e)))
				l (vl-remove-if-not '(lambda (x) (member (car x) '(0 1 8 40 50))) (entget (vlax-vla-object->ename e)))
			)
			((lambda (i / sn fnd)
				(while (setq sn (ssname ss (setq i (1+ i))))
					(if (setq fnd (ssget "_CP" (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget sn)))
									l
								  )
						)
						((lambda (n / o )
							(while (setq o (ssname fnd (setq n (1+ n))))
								(if (eq o (vlax-vla-object->ename e))
									(setq lst (cons (list sn (distance p (vlax-curve-getclosestpointto sn p))) lst))
								)
							)
						 )
						 -1
						)
					)
				);end_while
			 )
			 -1
			)
			(if lst 
				(entdel (caar (vl-sort lst '(lambda (j k) (< (cadr j) (cadr k))))))
			)
		);_end foreach
 
 (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
 (princ)
)

(vl-load-com)
(princ)

 

test3.dwg

[mhupp]

This might be a better/faster/easier way.

- Selects all closed polylines on c1602_0 layer

- Gets their vertex xy coordinates

- Runs a ssget "WP" with those coordinates if it selects a block name c1666 (inisde) it deletes that polyline

if nothing is selected checks the next polyline.

 

(defun c:foo (/ SS lst)
  (vl-load-com)
  (if (setq SS (ssget "_X" '((0 . "LWPOLYLINE") (8 . "C1602_0") (70 . 1) (410 . "Model"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (repeat (setq i (fix (1+ (vlax-curve-getEndParam e))))
        (setq lst (cons (trans (vlax-curve-getPointAtParam e (setq i (1- i))) 0 1) lst))
      )
      (if (ssget "_WP" lst '((0 . "INSERT") (2 . "C1666")))
        ;(vlax-put-property (vlax-ename->vla-object e) "color" 5) ;for testing
        (entdel e)
      )
    )
  )
  (princ)
)

Edited September 24, 2021 by mhupp
added (vl-load-com) so testing is uncommented it will work

[mhupp]

This still isn't 100%

noticed some plots don't have a boundary of their own.

like the one between 75, 37, 39, 41, 42, 49

once those plots are deleted nothing is there.

 

 

[mk4176]

Thank you very much, mhupp

Works for me

 

[mhupp]

@mk4176 sorry forgot to clear the lst this did two things. made it run longer 5763ms and also made some selections that it shouldn't have.

 

(defun c:foo (/ SS i lst)
  (vl-load-com)
  (if (setq SS (ssget "_X" '((0 . "LWPOLYLINE") (8 . "C1602_0") (70 . 1) (410 . "Model"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq lst nil) ;clears lst of previous cords
      (repeat (setq i (fix (1+ (vlax-curve-getEndParam e))))
        (setq lst (cons (trans (vlax-curve-getPointAtParam e (setq i (1- i))) 0 1) lst))
      )
      (if (ssget "_WP" lst '((0 . "insert") (2 . "C1666")))
        ;(vlax-put-property (vlax-ename->vla-object e) "color" 1) ;for testing
        (entdel e)
      )
    )
  )
  (princ)
)

 

with lst being clear each time the run time is much faster 47ms.  But it doesn't pick up  72, 75, 76, 77, 81, 82, 83 because the numbering is "outside" or crossing the boundary. two things to fix this.

 

1. make the numbering smaller so everything fits inside the boundary with refedit and attsync

2. change the ssget from "_WP" to "_CP". this would make if the block crossed the boundary it would be selected.

but this could also delete unwanted boundary's like the one left of 83.

3. you could just erase the smaller plots by hand.

 

Sorry I didn't catch this.

Edited September 27, 2021 by mhupp

[mhupp]

This uses the circles in the block as the selection testing so nothing crossed the boarder. works with 72,75,76,77,81,82,83

Makes a copy of each block before exploding them.

runs like normal but uses the small circle as the selection testing.

once done deletes all exploded blocks

pastes the old un-exploded blocks back into the drawing at the same location.

 

(defun c:foo (/ SS i lst)
  (vl-load-com)
  (setq LastEnt (entlast))
  (setq SS1 (ssget "_X" '((0 . "Insert") (2 . "C1666"))))
  (vl-cmdf "_.Copybase" "_non" "0,0,0" SS1 "")
  (vl-cmdf "_.Explode" SS1)
  (setq SS1 (ssadd))
  (if (setq en (entnext LastEnt))
    (while en
      (ssadd en SS1)
      (setq en (entnext en))
    )
  )
  (if (setq SS (ssget "_X" '((0 . "LWPOLYLINE") (8 . "C1602_0") (70 . 1) (410 . "Model"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq lst nil)  ;clears lst of previous cords
      (repeat (setq i (fix (1+ (vlax-curve-getEndParam e))))
        (setq lst (cons (trans (vlax-curve-getPointAtParam e (setq i (1- i))) 0 1) lst))
      )
      (if (ssget "_WP" lst '((0 . "CIRCLE") (8 . "0") (62 . 255) (40 . 0.0625)))
        ;(vlax-put-property (vlax-ename->vla-object e) "color" 1)  ;for testing
        (entdel e)
      )
    )
  )
  (vl-cmdf "_.Erase" SS1 "")
  (vl-cmdf "_.pasteclip" "_non" "0,0,0")
  (princ)
)

 

Edited September 27, 2021 by mhupp
uncommnet entdel

[mk4176]

Thanks mhupp,

What you did with the circle selection, is what I was trying to accomplish with this approach:

https://en.wikipedia.org/wiki/Point_in_polygon

Using the blocks insertion points, But I couldn't finish it, So I got back to Tharwat's code. 

I still lack a lot of knowledge in programming. I basically do my things by understanding others code then modify it to suit my needs.

Anyhow, thank you very much for your time and efforts looking at this again.

Best Regards