Compare two selection sets to make a fourth out of a third...

[dlbsurveysuk]

I know what I need to achieve but the coding for it is a bit beyond me...

Is this code correct to make two selection sets of the coordinates of, all blocks "PRE", and all on layer "TEXT", and a third set of all the text items on layer "TEXT"?

(setq TRcoord (cdr (assoc 10 (entget (ssname (ssget "_X" '((2 . "PTRE"))) 0)))))
(setq TXTcoord (cdr (assoc 10 (entget (ssname (ssget "_X" '((8 . "TEXT"))) 0)))))
(setq TXTS (ssget "_X" '((8 . "TEXT"))))

If so, I then need to compare the first two selection sets, and make a fourth selection set out of the third one of all selections whose coordinates in the second set match any selection in the first set, then perform a subroutine (defun c:TREN) on each text string in the fourth set...

(when I say match, all the coordinates in the second set have an x value that match by +/-0.001, and have a y value of 0.07 less (+/-0.001) than the match in the first set (does this mean a fuzz factor is involved), and z values are all over the place, but it's only the x,y that I need to pass on to the subroutine.)

I hope that all makes sense. Not sure if I'm overcomplicating things... Any help appreciated. Thanks

[dlbsurveysuk]

Hi, sorry to bother you again with this.

Thanks for the video showing the use of VLIDE, that's very helpful. Doing it in Notepad with no feedback was no good!

So I've cleared up the parenthesis and variable name errors using VLIDE.

I've tidied up the TREN part and corrected the bug. The TREN part now runs faster and I've tested it as a standalone (TRENTEST) working from a simple (setq s (ssget "_X" '((8 . "TEXT")))) and it works!

However, the TEST program still doesn't work...

I'm now getting no debug breaks, so am watching using breakpoints as you described.

The PTRE selection is returning the correct number of PTRE blocks as coordinates.

The TEXT selection is also returning the correct number of TEXT coordinates.

When it gets to the comparison it iterates through all the TEXT coordinates correctly but deletes them all and ends up with a selection set of nil.

I think that's what's happening... I just can't seem to figure out why...

PS. Is the "1e-3" part a 0.001 fuzz factor? I've run the code with the TEXT moved to be exactly on the PTRE points, so coordinates are exactly the same, and still getting the same result...

Thanks again.

(defun c:TRENTEST ( / s i c e l)

                            (defun *error* (MSG)

                                 (if (/= MSG "Function cancelled")
                                 (princ (strcat "\nError: " MSG)))

                                 (if osm (setvar "OSMODE" OSM))
                                 (if lyr (setvar "CLAYER" LYR))

                             (princ))

                             (defun LM:str->lst ( str del / pos )                    ;;; String to List  -  Lee Mac ;;; 
                                     (if (setq pos (vl-string-search del str))
                                     (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
                                     (list str))
                              )

           (setq OSM (getvar "OSMODE"))
           (setq LYR (getvar "CLAYER"))

(setq s (ssget "_X" '((8 . "TEXT"))))

(if  (and s (/= 0 (sslength s)))

       (repeat (setq i (sslength s))
           (setq i (1- i))
         
            (setq XY (cdr (assoc 10 (entget (ssname s i)))))             ;;;***    (setq xy (getpoint "Where? "))  
            (setq EN (entget (ssname s i)))                                        ;;;***    (setq en (car (entsel "Pick info: ")))
            
            (setq lst (LM:str->lst (cdr (assoc 1 EN)) "-"))                   ;;;    G-S-H-species
  
                 (setq tr (atof (car lst)))
                 (setq sp (atof (cadr lst)))
                 (setq h (atof (caddr lst)))
                 (setq spe (last lst))

                (command "osnap" "none")
   
                (command "LAYER" "M" "TRTEXT" "")
                (setq txy (polar xy 0.4636 0.894))
  
                (command "TEXT" txy "" "" spe)
                (command "TEXT" "" (strcat "G "(rtos tr 2 2)))
                (command "TEXT" "" (strcat "S "(rtos sp 2 1)))
                (command "TEXT" "" (strcat "H "(rtos h  2 0)))
  
                       (command "LAYER" "M" "TRTR" "")
                       (command "INSERT" "treebole" xy (/ tr PI) "" "")
  
                       (command "LAYER" "M" "TRCAN" "")
                       (command "INSERT" "trcan" xy sp "")           
      )
)
(setvar "OSMODE" OSM)
(setvar "CLAYER" LYR)
(princ)
)

(defun c:TEST ( / s i c e l)

                            (defun *error* (MSG)

                                 (if (/= MSG "Function cancelled")
                                 (princ (strcat "\nError: " MSG)))

                                 (if osm (setvar "OSMODE" OSM))
                                 (if lyr (setvar "CLAYER" LYR))

                             (princ))

                             (defun LM:str->lst ( str del / pos )                    ;;; String to List  -  Lee Mac ;;; 
                                     (if (setq pos (vl-string-search del str))
                                     (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
                                     (list str))
                              )

           (setq OSM (getvar "OSMODE"))
           (setq LYR (getvar "CLAYER"))

       (if (setq s (ssget "_X" '((2 . "PTRE"))))
          (repeat (setq i (sslength s)))
                 (setq c (cdr (assoc 10 (entget (ssname s (setq i (1- i))))))
	  l (cons c l)))

       (if (setq s (ssget "_X" '((8 . "TEXT"))))
               (repeat (setq i (sslength s))
                    (setq c (cdr (assoc 10 (entget (setq e (ssname s (setq i (1- i)))))))
	    l (vl-sort l (function (lambda (c1 c2) (< (distance c c1) (distance c c2))))))
                           (if (not (equal c (car l) 1e-3)) (ssdel e s))))

(if  (and s (/= 0 (sslength s)))

       (repeat (setq i (sslength s))
           (setq i (1- i))
         
            (setq XY (cdr (assoc 10 (entget (ssname s i)))))             ;;;***    (setq xy (getpoint "Where? "))  
            (setq EN (entget (ssname s i)))                                        ;;;***    (setq en (car (entsel "Pick info: ")))
            
            (setq lst (LM:str->lst (cdr (assoc 1 EN)) "-"))                   ;;;    G-S-H-species
  
                 (setq tr (atof (car lst)))
                 (setq sp (atof (cadr lst)))
                 (setq h (atof (caddr lst)))
                 (setq spe (last lst))

                (command "osnap" "none")
   
                (command "LAYER" "M" "TRTEXT" "")
                (setq txy (polar xy 0.4636 0.894))
  
                (command "TEXT" txy "" "" spe)
                (command "TEXT" "" (strcat "G "(rtos tr 2 2)))
                (command "TEXT" "" (strcat "S "(rtos sp 2 1)))
                (command "TEXT" "" (strcat "H "(rtos h  2 0)))
  
                       (command "LAYER" "M" "TRTR" "")
                       (command "INSERT" "treebole" xy (/ tr PI) "" "")
  
                       (command "LAYER" "M" "TRCAN" "")
                       (command "INSERT" "trcan" xy sp "")           
      )
)
(setvar "OSMODE" OSM)
(setvar "CLAYER" LYR)
(princ)
)

[dlbsurveysuk]

Hi, this looks helpful. Where and how would I insert it into the rest of the code (now updated) but not fully working...

[komondormrex]

hi. need to look at your c:tren command...beforehand

[dlbsurveysuk]

Thanks for replying. The (c:TRENTEST) above is basically the original (c:TREN) but modified to accept data from a list instead of from user picks.

[ВeekeeCZ · Accepted solution]

Great, you learn some. Fixed almost all, the fuzz was one of the issues. And as an extra, you created one more... fatal. 

You should be able to detect such an error by tracing. It is fixed in the code below. Also did some fine-tuning.

(vl-load-com)

(defun c:TEST ( / *error* LM:str->lst osm doc lyr xy en sp tr lst spe tdy s i c e l)
  
  (defun *error* (MSG)  ;; *error* ALWAYS NEEDS TO BE LOCALIZED !!!
    (if (/= MSG "Function cancelled")
      (princ (strcat "\nError: " MSG)))

    (if osm (setvar "OSMODE" OSM))
    (if lyr (setvar "CLAYER" LYR))
    (setvar 'cmdecho 1)
    (vla-endundomark doc)
    (princ))
  
  (defun LM:str->lst ( str del / pos )                    ;;; String to List  -  Lee Mac ;;;
    (if (setq pos (vl-string-search del str))
      (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
      (list str)))

  ; ==============================================================================================
  
  (setq OSM (getvar "OSMODE"))
  (setq LYR (getvar "CLAYER"))
  (setvar 'cmdecho 0)  ;;; listings slowes down the program. keep it on for debugging, then turn to off
  
  (if (setq s (ssget "_X" '((0 . "INSERT") (2 . "PTRE")))) ; better also filter by ent types
    (repeat (setq i (sslength s)) ;; wrong parent !
      (setq c (cdr (assoc 10 (entget (ssname s (setq i (1- i))))))
	    l (cons c l))))
  
  (if (and l
	   (setq s (ssget "_X" '((0 . "TEXT") (8 . "TEXT")))))
    (repeat (setq i (sslength s))
      (setq c (cdr (assoc 10 (entget (setq e (ssname s (setq i (1- i)))))))
	    l (vl-sort l (function (lambda (c1 c2) (< (distance c c1) (distance c c2))))))
      (if (not (equal c (car l) 0.1))
	(ssdel e s))))
  
  (if (and l s (/= 0 (sslength s))
	   (not (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))))
    
    (repeat (setq i (sslength s))
      (setq i (1- i))
      
      (setq XY (cdr (assoc 10 (entget (ssname s i)))))             ;;;***    (setq xy (getpoint "Where? "))
      (setq EN (entget (ssname s i)))                                        ;;;***    (setq en (car (entsel "Pick info: ")))
      
      (setq lst (LM:str->lst (cdr (assoc 1 EN)) "-"))                   ;;;    G-S-H-species
      
      (setq tr (atof (car lst)))
      (setq sp (atof (cadr lst)))
      (setq h (atof (caddr lst)))
      (setq spe (last lst))

      (setvar 'osmode 0)  ; always prefer sysvars over commands.
      ;;(command "osnap" "none")
      
      (command "LAYER" "M" "TRTEXT" "")
      (setq txy (polar xy 0.4636 0.894))
      
      (command "TEXT" txy "" "" spe)
      (command "TEXT" "" (strcat "G "(rtos tr 2 2)))
      (command "TEXT" "" (strcat "S "(rtos sp 2 1)))
      (command "TEXT" "" (strcat "H "(rtos h  2 0)))
      
      (command "LAYER" "M" "TRTR" "")
      ; (command "INSERT" "treebole" xy (/ tr PI) "" "")  
      (command "INSERT" "treebole" "_s" (/ tr PI) "_r" 0 "_non" xy)  ; to avoid issue with different num of inputs uni/non-uni scaled blks.
      
      (command "LAYER" "M" "TRCAN" "")
      ; (command "INSERT" "trcan" xy sp "")  
      (command "INSERT" "trcan" "_s" sp "_r" 0 "_non" xy)
      )
    
    )
  (setvar "OSMODE" OSM)
  (setvar "CLAYER" LYR)
  (setvar 'cmdecho 1)
  (vla-endundomark doc)
  (princ)
  )

[dlbsurveysuk]

That's fantastic! All seems to be working here.

Yeah that was a learning experience. Thanks for making me debug the code properly, I've learned a lot. Will definitely be using VLIDE instead of Notepad from now on! Hopefully leading to not having to ask so many questions, and writing more complex code on my own.

Thanks for the additional pointers/optimisations, and thanks for all your help.

[dlbsurveysuk]

Hi, the code has been fixed now by BeekeeCZ. Thanks for your input but don't worry about putting any more time into this on my behalf. Thanks.

[ВeekeeCZ]

Glad to help.

[komondormrex · Accepted solution]

BTW)

;****************************************************************************************************

	(defun check_layer_exist (layer_name / )
		(if (vl-catch-all-error-p
				(vl-catch-all-apply 'vla-item
									(list (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
										  layer_name
									)
				)
			)
			(vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) layer_name)
		)
		layer_name
	)

;****************************************************************************************************

(defun make_rectangular_list (insert_point fuzzyness)
	(list
		 (list (- (car insert_point) fuzzyness) (- (cadr insert_point) fuzzyness))
		 (list (- (car insert_point) fuzzyness) (+ (cadr insert_point) fuzzyness))
		 (list (+ (car insert_point) fuzzyness) (+ (cadr insert_point) fuzzyness))
		 (list (+ (car insert_point) fuzzyness) (- (cadr insert_point) fuzzyness))
	)
)

;****************************************************************************************************

(defun ftpb (/ insert_sset_ptre insert_index proximity_texts_list insert_ename insert_point
				 proximity_text_sset
			  )
	(setq insert_sset_ptre (ssget "_x" '((2 . "ptre")))
		  insert_index -1
	)
	(repeat (sslength insert_sset_ptre)
		(setq insert_ename (ssname insert_sset_ptre (setq insert_index (1+ insert_index)))
			  insert_point (cdr (assoc 10 (entget insert_ename)))
			  proximity_text_sset (ssget "_cp" (make_rectangular_list insert_point 0.07) '((0 . "text")))
		)
		(if proximity_text_sset
			(setq proximity_texts_list (append proximity_texts_list (list (list (ssname proximity_text_sset 0) insert_point))))
		)
	)
;	(sssetfirst nil proximity_texts_sset)
	proximity_texts_list
)

;****************************************************************************************************

(defun c:mark_tree ()
	(setq text_to_process_list (ftpb))
	(if text_to_process_list
		(foreach tree_data text_to_process_list
			(setq text_string (cdr (assoc 1 (entget (car tree_data)))))
			(if (= "." (substr text_string 1 1)) (setq text_string (strcat "0" text_string)))
			(setq text_string_list (read (strcat "(" (vl-string-translate "-" " " text_string) ")")))
			(setq dtext_start_position (mapcar '+ '(0.8 0.4 0) (cadr tree_data)))
			(vla-put-layer
				(vla-addtext (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							 (vl-symbol-name (last text_string_list))
							 (vlax-3d-point dtext_start_position)
							 0.07
				)
				(check_layer_exist "trtext")
			)
			(vla-put-layer
				(vla-addtext (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							 (strcat "G " (vl-princ-to-string (car text_string_list)))
							 (vlax-3d-point (setq dtext_start_position (mapcar '- dtext_start_position '(0 0.1133 0))))
							 0.07
				)
				"trtext"
			)
			(vla-put-layer
				(vla-addtext (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							 (strcat "S " (vl-princ-to-string (cadr text_string_list)))
							 (vlax-3d-point (setq dtext_start_position (mapcar '- dtext_start_position '(0 0.1133 0))))
							 0.07
				)
				"trtext"
			)
			(vla-put-layer
				(vla-addtext (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							 (strcat "H " (vl-princ-to-string (cadr text_string_list)))
							 (vlax-3d-point (setq dtext_start_position (mapcar '- dtext_start_position '(0 0.1133 0))))
							 0.07
				)
				"trtext"
			)
			(vla-put-layer
				(vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
								 (vlax-3d-point (cadr tree_data))
								 "trcan"
								 (cadr text_string_list)
								 (cadr text_string_list)
								 (cadr text_string_list)
								 0
				)
				(check_layer_exist "trcan")
			)
			(vla-put-layer
				(vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
								 (vlax-3d-point (cadr tree_data))
								 "treebole"
								 (/ (car text_string_list) pi)
								 (/ (car text_string_list) pi)
								 (/ (car text_string_list) pi)
								 0
				)
				(check_layer_exist "trtr")
			)
		)
		(princ "No tree found")
	)
)

[dlbsurveysuk]

I've just done some more testing and your code works perfectly on all 4 trees of the test drawing, whereas my original code plus the BeekeeCZ only picks up 2 of them...

Yours seems faster as well. Thanks very much.

[dlbsurveysuk]

Hmm spoke too soon.

Just tested further and on the original test drawing it only picks up 2 of the 4 trees.

Komondormrex's solution seems to work perfectly.

[dlbsurveysuk]

Thanks again for your code.

One thing I've now noticed is that the tree details text is set at 0.07

My original TREN routine relied on the current TEXTSIZE setting which varies depending on the plot scale of the drawing -

1:50=0.07, 1:100=0.14, 1:200=0.28. The same with LTSCALE (50,100,200 respectively).

This wasn't clear in my code as it was relying on variables previously changed by another Lisp routine (that I'm currently incorporating your code into).

I've tried changing all instances of "0.07" in your code which gives the correct TEXTSIZE but not the line spacing (text is all bunched up at TEXTSIZE=0.14). You've obviously completely rewritten all the code, most of which I don't really understand, and I can't see how to correct this...

[dlbsurveysuk]

Bove reply should have been addressed to you. Not sure what happened...

[dlbsurveysuk]

Haha. Above replies were supposed to be addressed to you, I've ben hitting the wrong replies.

[ВeekeeCZ]

What do you want to say by that? In my understanding it's: I haven't finished testing my code yet, it still throws an error. But I'm determined to work on it until I find and fix the bug. Because I want to understand every single step of my code.

[dlbsurveysuk]

Haha yes of course. I was just letting you know what was going on.

[Kent1Cooper]

---

@dlbsurveysuk wrote:

Bove reply should have been addressed to you. Not sure what happened...

---

You must have picked in the Reply to the topic... slot a the bottom of the page.  Replies posted there always show as being in Reply to Message 1 and the original poster [yourself in this case].  Instead of using that, be sure to use the REPLY button toward the bottom right within the specific Message you're Replying to.

[dlbsurveysuk]

Hi, I've figured out what I need to do but am having trouble understanding mapcar...

I think these are the lines of code that define the x,y,z position of the next text -

(vlax-3d-point (setq dtext_start_position (mapcar '- dtext_start_position '(0 0.1133 0))))

with 0.1133 being the value added to y

I want to make 0.1133 be (* 0.6 txtsize) where "txtsize" is already defined as (setq txtsize (getvar "textsize"))

If I do this -

(setq text_spacing (* 0.6 txtsize))

(vlax-3d-point (setq dtext_start_position (mapcar '- dtext_start_position '(0 text_spacing 0))))

I get -

; error: bad argument type: numberp: (TEXT_SPACING)

I'm obviously having some kind of fundamental misunderstanding... does this mean you can't mix numbers and variables? Been reading tutorials on it but can't seem to crack the code...

[Kent1Cooper]

---

@dlbsurveysuk wrote:

....

(setq text_spacing (* 0.6 txtsize))

(vlax-3d-point (setq dtext_start_position (mapcar '- dtext_start_position '(0 text_spacing 0))))

I get -

; error: bad argument type: numberp: (TEXT_SPACING)

....

---

The "quoted list" format, starting with '( , which is shorthand for the (quote) function, can be used only when every item inside it is to be "taken literally," that is, requires no evaluation.  So you can't include nested functions or variable names [they requires evaluation].  You need to use the explicit (list) function, where the variable name can be included:

(vlax-3d-point (setq dtext_start_position (mapcar '- dtext_start_position (list 0 text_spacing 0))))

If you don't have any additional use for that text_spacing variable, you can do without it, and just include that calculation right inside the list:

(vlax-3d-point (setq dtext_start_position (mapcar '- dtext_start_position (list 0 (* 0.6 txtsize) 0))))

Read about the (list) and (quote) functions in the AutoLisp Reference.

[By the way, in this case the 0.1133 is the value subtracted from y, since it's in a (mapcar '- ...) function.]

[dlbsurveysuk]

Thanks for the clear explanation. I was nearly there... All these little intricate options can do my head in (still a novice).

That's all working now.

Yeah I meant subtracted from y as it's the next line of text below, also my multiplication factor should have be 1.6 not 0.6.

Thanks again.