Autoselect nearest closed polyline that surrounds text entity

August 2, 2016

Hi All,

I'm after an Autolisp function that basically does the following:

User selects a text
Script finds nearest closed polyline that the text's insertion point lies inside

I.e. Given a point (the insertion point for the text entity), I want to automatically find the nearest closed polyline that the point lies in. The polyline is always closed.

Picture is below (hopefully clears up some confusion).

August 2, 2016

A way around is to pick text get insert pt then create a point at a distance away, using ssget "F" you pick a number of objects including polylines, using vl get closet pt to, you compare the distance to find closest pline. The code will exist I don't have anything but do a google search this is not a new topic its been asked before.

A quick google shows the simple example code

; by jeff_m 2007
(setq pt (getpoint "\nPoint: "))
(setq crvobj (car (entsel "\nSelect object: ")));can be any line, arc, pline, ellipse, spline
(setq closestpt (vlax-curve-getclosestpointto crvobj pt))

August 2, 2016

Yeah actually could do in two or more directions and find all entities that exist in both sets, if nothing found then keep squaring the length of the line or something similar.

I don't know how far it is to the polyline since it varies, that's the only minor drama.

That will definitely work and i know how to turn that into lisp script. Would like to hear some more suggestions of there is a more elegant way.

August 2, 2016

Your online live ! There may be a better way but that is all I could find quickly, sounds like you know about lisp so a quick press enter to accept search 500m etc would remove the search window problem or just code a number you know works, for 99% I do something in a program and use 5000m.

(setq ss (ssget "F" (list pt1 pt2))) will make a selection set of objects then just loop through check for Lwpolyline then do closestptto and compare always saving the smallest distance pt - new pt.

August 2, 2016

Thanks for the reply.

I'll get coding and see how it goes ;-) I've only just started with autolisp but i do have experience programming and have found autolisp fairly intuitive. Once you've got a few debug functions up and running it's pretty smooth sailing :-)

August 2, 2016

Here is a start I have to go now

; not tested in any way
(setq smalldist 5000.0)
(setq ent (assoc 10 (entget (car (entsel "Pick text")))))
(setq pt1 (list (cadr  ent)(caddr ent)))
(setq pt2 (polar (list (cadr  ent)(caddr ent)) 0.0 5000.0))
(setq ss (ssget "F" (list pt1 pt2)))
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
; dist = closestptto
(setq smalldist (distance (vlax-curve-getClosestPointTo Obj pt1) pt1))
(if (< dist smalldist)(setq smallobj obj)) ; obj is the closest poly line
) ; repeat

August 2, 2016

Cool, seems to work well. This is what I have so far, I haven't implemented the distance part yet and I haven't had a chance to clean up any of the code so it's horrible!

(defun L_A3_TAA( / MySet N1 C1 b ss1 ss2 ss3 ss4 ss5 textcent textget pt1 pt2 pt3 pt4 pt5)
 	(terpri)

 	;Get user to select objects if objects aren't already selected
(princ "Select a text box on the cadastre layer")
;	(setq MySet (ssget "X" '((-4 . "<OR")
;				 (8 . "BASE_CADASTRE_NUMBER_EXIST")
;				 (8 . "BASE_CADASTRE_NUMBER_PROP")
;				 (-4 . "OR>"))
;			   ))

 	(setq MySet (ssget))
 
 	(if (/= MySet nil)
	(progn
		;(print "not empty")
		(setq N1 (sslength MySet)
		      C1 0)
	  	;Loop though all selected (check layer)
	  	(repeat N1
			(setq b (ssname MySet C1))
			(setq textget (entget b))
		  
		  	;Check through selection set for text on cad layer
			(if (AND
			      	 (= (cdr (assoc 8 textget)) "BASE_CADASTRE_NUMBER_EXIST")
				 (OR
				   	(= (cdr (assoc 0 textget)) "TEXT")
				   	(= (cdr (assoc 0 textget)) "MTEXT")
				 )
			    )
				(progn
				  	;It is a text on the cadastre layer

				  	;Get text's alignment point
				  	(if (= (cdr (assoc 0 textget)) "MTEXT")
						(progn
						  	(setq textcent (assoc 10 textget))
						)
						(progn
						  	;if already centred
							(setq textcent (assoc 11 textget))
						)
					)

					;Select all polylines on layer 
					;Get points in left direction
				  	(setq pt1 (list (cadr textcent)(caddr textcent)))
				  	(setq pt2 (list (- (cadr textcent) 1000)(caddr textcent)))
				  	(setq pt3 (list (+ (cadr textcent) 1000)(caddr textcent)))
				  	(setq pt4 (list (cadr textcent)(- (caddr textcent) 1000)))
				  	(setq pt5 (list (cadr textcent)(+ (caddr textcent) 1000)))

					;Get all selection sets
					(setq ss1 (ssget "F" (list pt1 pt2)))
					(setq ss2 (ssget "F" (list pt1 pt3)))
					(setq ss3 (ssget "F" (list pt1 pt4)))
					(setq ss4 (ssget "F" (list pt1 pt5)))
					; '(8 . "BASE_CADASTRE_EXIST")
					
					(setq ss1 (L_RemoveNonDuplicates ss1 ss2))
					(setq ss1 (L_RemoveNonDuplicates ss1 ss3))
					(setq ss1 (L_RemoveNonDuplicates ss1 ss4))
					(setq ss1 (L_FiltCad ss1 "BASE_CADASTRE_EXIST"))
				  	(if (= (sslength ss1) 1)
					  	;Unique solution, continue
						(progn
							
						  )
					  	(progn
						 	;(print "hello")
							
						)
					  )
				)
			)
		  
			(setq C1 (+ C1 1))
		)
	)
)
 
)

(defun L_FiltCad(ss1 LAYNAME / ss3 n1)
; '(8 . "BASE_CADASTRE_EXIST")
(setq ss3 (ssadd))
 	(setq n1 0)
 	(if (= (sslength ss1) 0)
  (progn
  )
  (progn
    (repeat (sslength ss1)
      (progn
	    (if (= (cdr (assoc 8 (entget (ssname ss1 n1)))) LAYNAME)
		  (setq ss3 (ssadd (ssname ss1 n1) ss3))
	    )	  

	)
      )
  )
)
 
 	ss3
)

(defun L_RemoveNonDuplicates(ss1 ss2 / ss3 ss1n ss2n exists)
(setq ss3 (ssadd))
 	(if (OR (= (sslength ss1) 0) (= (sslength ss2) 0))
  (progn
    (print "One of the lists is empty")
    ;empty lists
  )
  (progn
     (setq ss1n 0)
     (repeat (sslength ss1)
       	(progn
    	     (setq ss2n 0)
       	     (setq exists 0)
	     (repeat (sslength ss2)
	             (progn
		       	(if (eq (ssname ss1 ss1n) (ssname ss2 ss2n))
				(progn
				  (setq exists 1)
				)
			)
		     	(setq ss2n (+ ss2n 1))
		     )
	     )
	     (if (= exists 1)
	       	(progn
		  (setq ss3 (ssadd (ssname ss1 ss1n) ss3))
	  	)
	     )
	     (setq ss1n (+ ss1n 1))
	  )
     )
  )
)

 	;Retun ss3
 	ss3
)

August 2, 2016

Hi,

Welcome to CADTutor.

It is been a while since I wrote a complete program in this forum as I used to be so here is my attempt in this regards - please try it and let me know.

(defun c:Test (/ *error* pik cad run sel p ray obj ss sn)
 ;;--------------------------------------------;;
 ;;	Tharwat - Date: 02.Aug.2016		;;
 ;; Auto-select polyline that surrounds	;;
 ;;  		picked text 			;;
 ;;--------------------------------------------;;
 (defun *error* (msg)
   (if ray
     (vla-delete ray)
   )
   (if (and msg (not (wcmatch msg "*CANCEL*,*EXIT*,*BREAK*")))
     (princ (strcat "\nError : " msg "..."))
   )
   (princ)
 )
 (if
   (and
     (if
       (= 4
          (logand
            4
            (cdr
              (assoc 70 (entget (tblobjname "LAYER" (getvar 'CLAYER))))
            )
          )
       )
        (alert "Current layer is Locked !")
        t
     )
     (setq pik (car (entsel "\npick on Text :")))
     (wcmatch (cdr (assoc 0 (entget pik))) "*TEXT")
     (setq cad (vlax-get-acad-object)
           run t
           sel (ssget "_X"
                      (list '(0 . "LWPOLYLINE")
                            '(-4 . "&=")
                            '(70 . 1)
                            (cons 410 (getvar 'CTAB))
                      )
               )
     )
     (setq
       ray (vlax-invoke
             (vla-get-block
               (vla-get-activelayout (vla-get-ActiveDocument cad))
             )
             'addray
             (setq p (cdr (assoc 10 (entget pik))))
             (polar p 0. 1.)
           )
     )
   )
    (progn
      (vla-ZoomExtents cad)
      (while (and (setq obj (ssname sel 0)) run)
        (if (and (vlax-invoke
                   (vlax-ename->vla-object obj)
                   'IntersectWith
                   ray
                   AcExtendNone
                 )
                 (setq ss (ssget "_CP"
                                 (mapcar 'cdr
                                         (vl-remove-if-not
                                           '(lambda (x) (= (car x) 10))
                                           (entget obj)
                                         )
                                 )
                                 '((0 . "*TEXT"))
                          )
                 )
            )
          (while (setq sn (ssname ss 0))
            (if (eq sn pik)
              (progn
                (setq run nil)
                (sssetfirst nil (ssadd obj))
              )
            )
            (ssdel sn ss)
          )
        )
        (ssdel obj sel)
      )
      (vla-delete ray)
      (vla-zoomprevious cad)
    )
 )
 (princ)
)(vl-load-com)

August 2, 2016

Nice code, Tharwat!

I haven't tried it yet.. but I'm learning from it by reading.

And I'm not sure what does logand means / logical bitwise, although I was reading the HELP.

And this part of your code doesn't seem the standart way of creating a ray object:

      (setq
       ray (vlax-invoke
             (vla-get-block
               (vla-get-activelayout (vla-get-ActiveDocument cad))
             )
             'addray
             (setq p (cdr (assoc 10 (entget pik))))
             (polar p 0. 1.)
           )
     )

when I compare it from the HELP:

(setq rayObj (vla-AddRay modelSpace basePoint secondPoint))

So my second question would be how did you figure this out?

Ontopic, my suggestion would be:

1.Entsel the text and store its insertion point (pt)

2.Create bpoly from (pt), then store a selection (ss) using "Fence" method

3.Get bpoly's boundingbox coordinates, and erase it

4.Iterate through the (ss), and check for matching values of the boundingbox's "sn" and the "bpoly", if they match grip the "sn"

August 3, 2016

Hi Grrr,

logand function is to check if a logical bit-wise is in a list and you can explore the Group Code as described in the help document for 70 HERE.

In regard to adding a ray object, the two ways working mine and yours but my way does not need to convert the coordinates into a variant to create the ray object but yours it does need that and that is the only reason behind the structure of my codes.

Would like to see your suggestion into codes.

August 3, 2016

Here is another approach, less codes and more direct process - just for fun.

(defun c:Test ( / s ss i e p l cad  lst)
 ;;--------------------------------------------;;
 ;;	Tharwat - Date: 03.Aug.2016		;;
 ;; Auto-select polyline that surrounds	;;
 ;;  		picked text 			;;
 ;;--------------------------------------------;;
 (if (and (setq s (car (entsel "\nSelect Text :")))
          (wcmatch (cdr (assoc 0 (entget s))) "*TEXT")
          (setq e (entget s)
                p (cdr (assoc 10 e))
                l (vl-remove-if-not '(lambda (x) (member (car x) '(0 1 8 40 50))) e)
                cad (vlax-get-acad-object)
                ss (ssget "_X" (list '(0 . "LWPOLYLINE") '(-4 . "&=") '(70 . 1)
                                     (cons 410 (getvar 'CTAB)))))
          )
   (progn
      (vla-ZoomExtents cad)
     ((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 s)
                             (setq lst (cons (list sn (distance p (vlax-curve-getclosestpointto sn p))) lst))
                             )
                          )
                        )
                       -1
                       )
            )
          )
        )
       -1
       )
     (if lst (sssetfirst nil (ssadd (caar (vl-sort lst '(lambda (j k) (< (cadr j) (cadr k))))))))
     (vla-ZoomPrevious cad)))
 (princ)
 )(vl-load-com)

August 3, 2016

Nice coding Tharwat. Using the filter list 'l' is a clever idea.

Since that list also contains gc 5 (the handle of the text entity) fnd will either be nil or a selection set containing a single entity. So your code can be simplified I think.

August 3, 2016

Nice coding Tharwat. Using the filter list 'l' is a clever idea.

Thank you Roy for your feedback, it's highly appreciated.

Since that list also contains gc 5 (the handle of the text entity) fnd will either be nil or a selection set containing a single entity. So your code can be simplified I think.

Sorry I did not get your point. Could you clarify it a bit more?

August 3, 2016

Sorry I did not get your point. Could you clarify it a bit more?

Oops! You are right to be confused. My additional remark doesn't make much sense. First your 'l' list does not contain a gc 5 item. Second (ssget) doesn't even recognize that group code.

:oops:

August 4, 2016

Oops! You are right to be confused. My additional remark doesn't make much sense. First your 'l' list does not contain a gc 5 item. Second (ssget) doesn't even recognize that group code.:oops:

Entirely true, the group code '5' (handle) can not be used in filters with ssget function to select a specific entity so what is why I omitted that DXF group.

Regards.

August 4, 2016

Hi Grrr,

Would like to see your suggestion into codes.

Hi, Tharwat

My suggestion would be something like this:

[b][color=BLACK]([/color][/b]defun C:test [b][color=FUCHSIA]([/color][/b] / go txt pt pty bply bply-elist bply-obj bply-box SS i ent ent-obj ent-box bp1 bp2 ep1 ep2[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]sssetfirst nil nil[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]setq go T[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]while go
	[b][color=NAVY]([/color][/b]while [color=#8b4513]; the goal here is to create the bpoly, and get its elist [b][color=MAROON]([/color][/b]so later the bpoly's bbox will be known, and the SS[b][color=MAROON])[/color][/b][/color]
		[b][color=MAROON]([/color][/b]not
			[b][color=GREEN]([/color][/b]and
				[b][color=BLUE]([/color][/b]setq txt [b][color=RED]([/color][/b]entsel [color=#2f4f4f]"\nPick text/mtext or <eXit> : "[/color][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
				[b][color=BLUE]([/color][/b]member [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 0 [b][color=TEAL]([/color][/b]entget [b][color=OLIVE]([/color][/b]car txt[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]list [color=#2f4f4f]"TEXT"[/color] [color=#2f4f4f]"MTEXT"[/color][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
				[b][color=BLUE]([/color][/b]setq pt [b][color=RED]([/color][/b]cadr txt[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
				[color=#8b4513]; emake point, to check the [color=#2f4f4f]"_.-boundary"[/color] evaluation:[/color]
				[b][color=BLUE]([/color][/b]entmakex [b][color=RED]([/color][/b]list [b][color=PURPLE]([/color][/b]cons 0 [color=#2f4f4f]"POINT"[/color][b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]cons 10 pt[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
				[b][color=BLUE]([/color][/b]setq pty [b][color=RED]([/color][/b]entlast[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [color=#8b4513]; the [color=#2f4f4f]"entlast"[/color] would be point[/color]
				[b][color=BLUE]([/color][/b]vl-cmdf [color=#2f4f4f]"_.-boundary"[/color] [color=#2f4f4f]"_A"[/color] [color=#2f4f4f]"_I"[/color] [color=#2f4f4f]"_N"[/color] [color=#2f4f4f]""[/color] [color=#2f4f4f]"_O"[/color] [color=#2f4f4f]"_P"[/color] [color=#2f4f4f]""[/color] [color=#2f4f4f]"_non"[/color] pt [color=#2f4f4f]""[/color][b][color=BLUE])[/color][/b] [color=#8b4513]; if successful[/color]
				[b][color=BLUE]([/color][/b]setq bply [b][color=RED]([/color][/b]entlast[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [color=#8b4513]; the last created entity[/color]
				[b][color=BLUE]([/color][/b]setq bply-elist [b][color=RED]([/color][/b]entget bply[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
				[b][color=BLUE]([/color][/b]= [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 0 bply-elist[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=BLUE])[/color][/b] [color=#8b4513]; is poly[/color]
				[b][color=BLUE]([/color][/b]= [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 70 bply-elist[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] 1[b][color=BLUE])[/color][/b] [color=#8b4513]; is closed[/color]
			[b][color=GREEN])[/color][/b]
		[b][color=MAROON])[/color][/b]
		
		[b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]or [b][color=BLUE]([/color][/b]= [b][color=RED]([/color][/b]getvar 'errno[b][color=RED])[/color][/b] 7[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]null [b][color=RED]([/color][/b]car txt[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]not bply-elist[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]princ [color=#2f4f4f]"\nYou missed, try again!"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
	[b][color=NAVY])[/color][/b][color=#8b4513]; while[/color]
	[color=#8b4513]; entdel the point:[/color]
	[b][color=NAVY]([/color][/b]if pty [b][color=MAROON]([/color][/b]entdel pty[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]setq bply-obj [b][color=MAROON]([/color][/b]vlax-ename->vla-object bply[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]vla-getboundingbox bply-obj 'bp1 'bp2[b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]setq bply-box [b][color=MAROON]([/color][/b]mapcar 'vlax-safearray->list [b][color=GREEN]([/color][/b]list bp1 bp2[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]setq bp1 [b][color=MAROON]([/color][/b]trans [b][color=GREEN]([/color][/b]car bply-box[b][color=GREEN])[/color][/b] 0 1[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]setq bp2 [b][color=MAROON]([/color][/b]trans [b][color=GREEN]([/color][/b]cadr bply-box[b][color=GREEN])[/color][/b] 0 1[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]if 
		[b][color=MAROON]([/color][/b]setq SS [b][color=GREEN]([/color][/b]ssget [color=#2f4f4f]"_CP"[/color] [b][color=BLUE]([/color][/b]mapcar 'cdr [b][color=RED]([/color][/b]vl-remove-if-not '[b][color=PURPLE]([/color][/b]lambda [b][color=TEAL]([/color][/b]x[b][color=TEAL])[/color][/b] [b][color=TEAL]([/color][/b]= [b][color=OLIVE]([/color][/b]car x[b][color=OLIVE])[/color][/b] 10[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]entget bply[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
			[color=#8b4513]; '[b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=BLUE])[/color][/b] '[b][color=BLUE]([/color][/b]-4 . [color=#2f4f4f]"&="[/color][b][color=BLUE])[/color][/b] '[b][color=BLUE]([/color][/b]70 . 1[b][color=BLUE])[/color][/b][/color]
		[b][color=GREEN])[/color][/b]
		[b][color=MAROON])[/color][/b] [color=#8b4513]; select along the bpoly[/color]
		[b][color=MAROON]([/color][/b]progn
			[b][color=GREEN]([/color][/b]if bply [b][color=BLUE]([/color][/b]ssdel bply SS[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [color=#8b4513]; remove the bpoly from SS[/color]
			[b][color=GREEN]([/color][/b]repeat [b][color=BLUE]([/color][/b]setq i [b][color=RED]([/color][/b]sslength SS[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [color=#8b4513]; iterate through selection[/color]
				[b][color=BLUE]([/color][/b]setq ent [b][color=RED]([/color][/b]ssname SS [b][color=PURPLE]([/color][/b]setq i [b][color=TEAL]([/color][/b]1- i[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
				[b][color=BLUE]([/color][/b]setq ent-obj [b][color=RED]([/color][/b]vlax-ename->vla-object ent[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
				[b][color=BLUE]([/color][/b]vla-getboundingbox ent-obj 'ep1 'ep2[b][color=BLUE])[/color][/b]
				[b][color=BLUE]([/color][/b]setq ent-box [b][color=RED]([/color][/b]mapcar 'vlax-safearray->list [b][color=PURPLE]([/color][/b]list ep1 ep2[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
				[b][color=BLUE]([/color][/b]setq ep1 [b][color=RED]([/color][/b]trans [b][color=PURPLE]([/color][/b]car ent-box[b][color=PURPLE])[/color][/b] 0 1[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
				[b][color=BLUE]([/color][/b]setq ep2 [b][color=RED]([/color][/b]trans [b][color=PURPLE]([/color][/b]cadr ent-box[b][color=PURPLE])[/color][/b] 0 1[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
				
				[b][color=BLUE]([/color][/b]if 
					[b][color=RED]([/color][/b]not
						[b][color=PURPLE]([/color][/b]and
							[color=#8b4513]; THIS SET BELOW ISN'T WORKING![/color]
							[color=#8b4513]; check if the [color=#2f4f4f]"ent-obj"[/color] and [color=#2f4f4f]"bpoly-obj"[/color] bounding boxes match:[/color]
							[color=#8b4513]; [b][color=TEAL]([/color][/b]eq [b][color=OLIVE]([/color][/b]car bply-box[b][color=OLIVE])[/color][/b] [b][color=OLIVE]([/color][/b]car ent-box[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][/color]
							[color=#8b4513]; [b][color=TEAL]([/color][/b]eq [b][color=OLIVE]([/color][/b]cadr bply-box[b][color=OLIVE])[/color][/b] [b][color=OLIVE]([/color][/b]cadr ent-box[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][/color]
							
							[color=#8b4513]; [b][color=TEAL]([/color][/b]eq bply-box ent-box[b][color=TEAL])[/color][/b] ; is this enough ?![/color]
							[b][color=TEAL]([/color][/b]not [b][color=OLIVE]([/color][/b]eq bply ent[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b] [color=#8b4513]; not the bpoly[/color]
							[b][color=TEAL]([/color][/b]= [b][color=OLIVE]([/color][/b]cdr [b][color=GRAY]([/color][/b]assoc 0 [b][color=AQUA]([/color][/b]entget ent[b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b] [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=TEAL])[/color][/b] [color=#8b4513]; is poly[/color]
							[b][color=TEAL]([/color][/b]= [b][color=OLIVE]([/color][/b]cdr [b][color=GRAY]([/color][/b]assoc 70 [b][color=AQUA]([/color][/b]entget ent[b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b] 1[b][color=TEAL])[/color][/b] [color=#8b4513]; is closed[/color]
						[b][color=PURPLE])[/color][/b]
					[b][color=RED])[/color][/b]
					[b][color=RED]([/color][/b]ssdel ent SS[b][color=RED])[/color][/b] [color=#8b4513]; erase the [color=#2f4f4f]"ent"[/color] from SS if the [color=#2f4f4f]"ent"[/color] doesn't match the requirements[/color]
				[b][color=BLUE])[/color][/b]
			[b][color=GREEN])[/color][/b][color=#8b4513]; repeat[/color]
			[color=#8b4513]; [b][color=GREEN]([/color][/b]if [b][color=BLUE]([/color][/b]= [b][color=RED]([/color][/b]length SS[b][color=RED])[/color][/b] 1[b][color=BLUE])[/color][/b][/color]
			[b][color=BLUE]([/color][/b]sssetfirst nil SS[b][color=BLUE])[/color][/b]
			[color=#8b4513]; [b][color=GREEN])[/color][/b] ; grip tbe selection[/color]
			[b][color=GREEN]([/color][/b]setq go nil[b][color=GREEN])[/color][/b] [color=#8b4513]; stop the loop[/color]
			[b][color=GREEN]([/color][/b]if bply [b][color=BLUE]([/color][/b]entdel bply[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [color=#8b4513]; erase the bpoly[/color]
		[b][color=MAROON])[/color][/b][color=#8b4513]; progn[/color]
	[b][color=NAVY])[/color][/b][color=#8b4513]; if SS[/color]
	
[b][color=FUCHSIA])[/color][/b][color=#8b4513]; while go[/color]
[b][color=FUCHSIA]([/color][/b]princ[b][color=FUCHSIA])[/color][/b]
[b][color=BLACK])[/color][/b][color=#8b4513]; defun[/color]

Unfortunatelly, for some unknown reason I can't get the bounding-boxes comparison to work, I've tried to compare those set of point of "bply-box" and "ent-box". So for now the result is selecting everything along that enclosing rectangle.

It would be nice if you put some revision, since I couldn't figure out even this:

(setq SS (ssget "_CP" (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget bply)))
			; '(0 . "LWPOLYLINE") '(-4 . "&=") '(70 . 1)
		)
		) ; select along the bpoly

Sory for the late reply, I don't have much free time to practice.

August 4, 2016

@Grrr:

To compare lists you must use (equal) instead of (eq). You will also need to supply the fuzz argument.

(equal bply-box ent-box 1e-4)

August 4, 2016

Hi, Tharwat
My suggestion would be something like this:

Good start indeed although you don't need to go that long way.

I don't think you need to find bounding box for every object as you did into your program since it is needless.

It would be nice if you put some revision, since I couldn't figure out even this:
(setq SS (ssget "_CP" (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget bply)))
			; '(0 . "LWPOLYLINE") '(-4 . "&=") '(70 . 1)
		)
		) ; select along the bpoly

Have a look at Lee's description HERE and you can just read the related part to your question.

August 4, 2016

So, ok heres my final code:

[color=#8b4513]; expects to select text/mtext inside of closed polyline[/color]
[color=#8b4513]; then grips that polyline[/color]
[b][color=BLACK]([/color][/b]defun C:test [b][color=FUCHSIA]([/color][/b] / *error* oldcmd txt pt pty bply bply-elist bply-obj bply-box SS i ent ent-obj ent-box bp1 bp2 ep1 ep2[b][color=FUCHSIA])[/color][/b]

[b][color=FUCHSIA]([/color][/b]defun *error* [b][color=NAVY]([/color][/b] msg [b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]if oldcmd [b][color=MAROON]([/color][/b]setvar 'cmdecho oldcmd[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]if pty [b][color=MAROON]([/color][/b]entdel pty[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]if bply [b][color=MAROON]([/color][/b]entdel bply[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]member msg '[b][color=BLUE]([/color][/b][color=#2f4f4f]"Function cancelled"[/color] [color=#2f4f4f]"quit / exit abort"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
		[b][color=MAROON]([/color][/b]princ [b][color=GREEN]([/color][/b]strcat [color=#2f4f4f]"\nError: "[/color] msg[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
	[b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]princ[b][color=NAVY])[/color][/b]
[b][color=FUCHSIA])[/color][/b]

[b][color=FUCHSIA]([/color][/b]setq oldcmd [b][color=NAVY]([/color][/b]getvar 'cmdecho[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]setvar 'cmdecho 0[b][color=FUCHSIA])[/color][/b]

[b][color=FUCHSIA]([/color][/b]while [color=#8b4513]; the goal here is to create the bpoly, and get its elist [b][color=NAVY]([/color][/b]so later the bpoly's bbox will be known, and the SS[b][color=NAVY])[/color][/b][/color]
	[b][color=NAVY]([/color][/b]not
		[b][color=MAROON]([/color][/b]and				
			[b][color=GREEN]([/color][/b]setq txt [b][color=BLUE]([/color][/b]entsel [color=#2f4f4f]"\nPick text/mtext inside of closed polyline: "[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]member [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 0 [b][color=PURPLE]([/color][/b]entget [b][color=TEAL]([/color][/b]car txt[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]list [color=#2f4f4f]"TEXT"[/color] [color=#2f4f4f]"MTEXT"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]setq pt [b][color=BLUE]([/color][/b]cadr txt[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[color=#8b4513]; emake point, to check the [color=#2f4f4f]"_.-boundary"[/color] evaluation:[/color]
			[b][color=GREEN]([/color][/b]entmakex [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cons 0 [color=#2f4f4f]"POINT"[/color][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]cons 10 pt[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]setq pty [b][color=BLUE]([/color][/b]entlast[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [color=#8b4513]; the [color=#2f4f4f]"entlast"[/color] would be point[/color]
			[b][color=GREEN]([/color][/b]vl-cmdf [color=#2f4f4f]"_.-boundary"[/color] [color=#2f4f4f]"_A"[/color] [color=#2f4f4f]"_I"[/color] [color=#2f4f4f]"_N"[/color] [color=#2f4f4f]""[/color] [color=#2f4f4f]"_O"[/color] [color=#2f4f4f]"_P"[/color] [color=#2f4f4f]""[/color] [color=#2f4f4f]"_non"[/color] pt [color=#2f4f4f]""[/color][b][color=GREEN])[/color][/b] [color=#8b4513]; if successful[/color]
			[b][color=GREEN]([/color][/b]setq bply [b][color=BLUE]([/color][/b]entlast[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [color=#8b4513]; the last created entity[/color]
			[b][color=GREEN]([/color][/b]setq bply-elist [b][color=BLUE]([/color][/b]entget bply[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]= [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 0 bply-elist[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=GREEN])[/color][/b] [color=#8b4513]; is poly[/color]
			[b][color=GREEN]([/color][/b]= [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 70 bply-elist[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] 1[b][color=GREEN])[/color][/b] [color=#8b4513]; is closed[/color]
		[b][color=MAROON])[/color][/b]
	[b][color=NAVY])[/color][/b]
	[b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]or [b][color=GREEN]([/color][/b]= [b][color=BLUE]([/color][/b]getvar 'errno[b][color=BLUE])[/color][/b] 7[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]null [b][color=BLUE]([/color][/b]car txt[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]not bply-elist[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]princ [color=#2f4f4f]"\nYou missed, try again!"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
[b][color=FUCHSIA])[/color][/b][color=#8b4513]; while[/color]
[color=#8b4513]; entdel the point:[/color]
[b][color=FUCHSIA]([/color][/b]if pty [b][color=NAVY]([/color][/b]entdel pty[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]setq bply-obj [b][color=NAVY]([/color][/b]vlax-ename->vla-object bply[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]vla-getboundingbox bply-obj 'bp1 'bp2[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]setq bply-box [b][color=NAVY]([/color][/b]mapcar 'vlax-safearray->list [b][color=MAROON]([/color][/b]list bp1 bp2[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]setq bp1 [b][color=NAVY]([/color][/b]trans [b][color=MAROON]([/color][/b]car bply-box[b][color=MAROON])[/color][/b] 0 1[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]setq bp2 [b][color=NAVY]([/color][/b]trans [b][color=MAROON]([/color][/b]cadr bply-box[b][color=MAROON])[/color][/b] 0 1[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]if 
	[b][color=NAVY]([/color][/b]setq SS 
		[b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"_CP"[/color]
			[b][color=GREEN]([/color][/b]mapcar 'cdr [b][color=BLUE]([/color][/b]vl-remove-if-not '[b][color=RED]([/color][/b]lambda [b][color=PURPLE]([/color][/b]x[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]= [b][color=TEAL]([/color][/b]car x[b][color=TEAL])[/color][/b] 10[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]entget bply[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			'[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]70 . 1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
		[b][color=MAROON])[/color][/b]
	[b][color=NAVY])[/color][/b] [color=#8b4513]; select along the bpoly[/color]
	[b][color=NAVY]([/color][/b]progn
		[b][color=MAROON]([/color][/b]if bply [b][color=GREEN]([/color][/b]ssdel bply SS[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [color=#8b4513]; remove the bpoly from SS[/color]
		[b][color=MAROON]([/color][/b]if bply [b][color=GREEN]([/color][/b]entdel bply[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [color=#8b4513]; erase the bpoly[/color]
		[b][color=MAROON]([/color][/b]repeat [b][color=GREEN]([/color][/b]setq i [b][color=BLUE]([/color][/b]sslength SS[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [color=#8b4513]; iterate through selection[/color]
			[b][color=GREEN]([/color][/b]setq ent [b][color=BLUE]([/color][/b]ssname SS [b][color=RED]([/color][/b]setq i [b][color=PURPLE]([/color][/b]1- i[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]setq ent-obj [b][color=BLUE]([/color][/b]vlax-ename->vla-object ent[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]vla-getboundingbox ent-obj 'ep1 'ep2[b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]setq ent-box [b][color=BLUE]([/color][/b]mapcar 'vlax-safearray->list [b][color=RED]([/color][/b]list ep1 ep2[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]setq ep1 [b][color=BLUE]([/color][/b]trans [b][color=RED]([/color][/b]car ent-box[b][color=RED])[/color][/b] 0 1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]setq ep2 [b][color=BLUE]([/color][/b]trans [b][color=RED]([/color][/b]cadr ent-box[b][color=RED])[/color][/b] 0 1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
			[b][color=GREEN]([/color][/b]if 
				[b][color=BLUE]([/color][/b]not
					[b][color=RED]([/color][/b]and
						[color=#8b4513]; check if the [color=#2f4f4f]"ent-obj"[/color] and [color=#2f4f4f]"bpoly-obj"[/color] bounding boxes match:[/color]
						[b][color=PURPLE]([/color][/b]equal bply-box ent-box 1e-4[b][color=PURPLE])[/color][/b] [color=#8b4513]; to compare lists use [color=#2f4f4f]"equal"[/color] function, and set fuzz factor[/color]
						[color=#8b4513]; the below lines are just to check anyway:[/color]
						[b][color=PURPLE]([/color][/b]not [b][color=TEAL]([/color][/b]eq bply ent[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [color=#8b4513]; not the bpoly[/color]
						[b][color=PURPLE]([/color][/b]= [b][color=TEAL]([/color][/b]cdr [b][color=OLIVE]([/color][/b]assoc 0 [b][color=GRAY]([/color][/b]entget ent[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b] [color=#2f4f4f]"LWPOLYLINE"[/color][b][color=PURPLE])[/color][/b] [color=#8b4513]; is poly[/color]
						[b][color=PURPLE]([/color][/b]= [b][color=TEAL]([/color][/b]cdr [b][color=OLIVE]([/color][/b]assoc 70 [b][color=GRAY]([/color][/b]entget ent[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b] 1[b][color=PURPLE])[/color][/b] [color=#8b4513]; is closed[/color]
					[b][color=RED])[/color][/b]
				[b][color=BLUE])[/color][/b]
				[b][color=BLUE]([/color][/b]ssdel ent SS[b][color=BLUE])[/color][/b] [color=#8b4513]; erase the [color=#2f4f4f]"ent"[/color] from SS if the [color=#2f4f4f]"ent"[/color] doesn't match the requirements[/color]
			[b][color=GREEN])[/color][/b]
		[b][color=MAROON])[/color][/b][color=#8b4513]; repeat[/color]
		[b][color=MAROON]([/color][/b]sssetfirst nil SS[b][color=MAROON])[/color][/b][color=#8b4513]; grip tbe selection[/color]
		[b][color=MAROON]([/color][/b]setvar 'cmdecho oldcmd[b][color=MAROON])[/color][/b]
	[b][color=NAVY])[/color][/b][color=#8b4513]; progn[/color]
[b][color=FUCHSIA])[/color][/b][color=#8b4513]; if SS[/color]
[b][color=FUCHSIA]([/color][/b]princ[b][color=FUCHSIA])[/color][/b]
[b][color=BLACK])[/color][/b][color=#8b4513]; defun[/color]

I keep some uneeded stuff, if I have to revise it someday.

This is a practice routine, so the credits should go to Roy and Tharwat..

And it was fun to write as an alternative method.

August 11, 2016

Nice, I will have to test this at some point.

I did get something working but it needs a hell of a lot of cleaning up.

If only I had a time machine, then I'd have enough time for everything

Autoselect nearest closed polyline that surrounds text entity

Recommended Posts

alm865

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

mk4176

Posted Images

BIGAL

Link to comment

Share on other sites

alm865

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

alm865

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

alm865

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

Grrr

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

Roy_043

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

Roy_043

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

Grrr

Link to comment

Share on other sites

Roy_043

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

Grrr

Link to comment

Share on other sites

alm865

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity