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

[dbroad]

1. If you can't code well, don't try to do too much on each line. 
2. Each line of your posted code will result in the insertion point of a single block, not of a group of blocks. Save the selection sets first.
3. You've mispelled "PRE" either in your explanation or in your code.

Visit leemac's website for a complete discussion of processing selection sets.

[dlbsurveysuk]

Oops yes both should be "PTRE".

Ah ok I see now, so I need to -

(if (setq PTREset (ssget "_X" '((2 . "PTRE"))))
       (repeat (setq i (sslength PTREset))
              (setq i (1- i))
              (setq TRcoord(cdr )assoc 10 (entget (ssname PTREset i)))
       )
)

?

Thanks for the advice, my coding is improving, but slowly...

[dlbsurveysuk]

*

(setq TRcoord (cdr (assoc 10 (entget (ssname PTREset i))) 0))

[ВeekeeCZ]

post the TREN func.

[dlbsurveysuk]

This is the TREN function. Pick a point entity and then the text string in the form (Girth-Spread-Height-Species) that is sitting over the point . It separates the string using the "-" delimeter then draws a tree trunk and canopy to scale with a formatted note. My goal is to auto find all these points + text and draw all the trees in one go. All the tree points are in their own layer "PTRE" but the text strings are in a general "TEXT" layer, so need isolating from other text and matching with their partnering point.

(defun c:TREN ()

         (defun *error* (MSG)

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

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

          (princ) )

  ;; String to List  -  Lee Mac  ;; http://www.lee-mac.com/stringtolist.html
  ;; Separates a string using a given delimiter
  ;; str - [str] String to process
  ;; del - [str] Delimiter by which to separate the string
  ;; Returns: [lst] List of strings
  
  (defun LM:str->lst ( str del / pos )
    (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"))

           (command "osnap" "INSERT")
           (setq xy (getpoint "Where? "))
  
           (setq en (car (entsel "Pick info: ")))
           (setq lst (LM:str->lst (cdr (assoc 1 (entget 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)
  )

[ВeekeeCZ]

This is your starting point. Your 4th ss is called s. Your 1st ss is called s, your 2nd one too. The is no 3rd one though.

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

  (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 . "PTRE"))))
    (repeat (setq i (sslength s))
      (setq c (cdr (assoc 10 (entget (setq e (ssname s (setq i (1- i)))))))
	    l (vl-sort l '(lambda (c1 c2) (< (distance c c1) (distance c c2)))))
      (if (not (equal c (car l) 1e-1)) (ssdel e s))))

  (if (and s (/= 0 (sslength s)))
    do whatever you want to do with c:TREN...........

[dlbsurveysuk]

PS. If the text string was exactly over the point/insert it could all be done from the text string insertion point but the text string is off by approx 0.07 as I mentioned before and the tree needs to sit on the point/insert

[dlbsurveysuk]

Woah that was fast. Thanks. I'll examine it...

[dlbsurveysuk]

Should the second (if be (8."TEXT") ? I've tried it and get nil

Can't seem to make sense of it...

As they are -

If I run the first (if on it's own I get a list of "PTRE" coordinates.

If I run both (if together I get nil

Thanks

[ВeekeeCZ]

Sure, whatever meets your needs.

[dlbsurveysuk]

Assuming from your description that fourth set s contains only the text that has matching coordinates to the first set s (blocks) ?...

Tried this - with the TREN routine in a repeat loop, with the (setq  XY) and (setq EN) lines modified to get info from the list, but it doesn't work - ; error: bad argument type: lselsetp nil

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

  (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 ss))

         (setq c (cdr (assoc 10 (entget (setq e (ssname ss (setq i (1- i)))))))
	    l (vl-sort l '(lambda (c1 c2) (< (distance c c1) (distance c c2)))))
         (if (not (equal c (car l) 1e-3)) (ssdel e ss))))


(if (and s (/= 0 (sslength s)))                  ;;    do whatever you want to do with c:TREN...........

     (repeat (setq i (sslength s))
                    (setq i (1- i))


         (defun *error* (MSG)

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

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

          (princ) )

  ;; String to List  -  Lee Mac  ;; http://www.lee-mac.com/stringtolist.html
  ;; Separates a string using a given delimiter
  ;; str - [str] String to process
  ;; del - [str] Delimiter by which to separate the string
  ;; Returns: [lst] List of strings
  
  (defun LM:str->lst ( str del / pos )
    (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"))

           (command "osnap" "INSERT")
         
            (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 (entget 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)
 );repeat
);if

(princ)
)

[ВeekeeCZ]

Post some test dwg.

States before, and after.

btw it would be nice if you read the code, not the description.

[dlbsurveysuk]

I have been trying to read the code - I think spending literally hours trying to understand it but seem to be getting nowhere... I can understand isolated parts but then get lost when variable names aren't descriptive and there are multiple functions nested multiple times. I'm trying.

I've isolated some PTRE blocks and some layer TEXT to a drawing. There are 4 tree positions with associated text that isn't quite in the same positions, and other isolated text that needs to be ignored.

Thanks for taking the time to look at this.

[ВeekeeCZ]

OK. There are like 8 errors to fix. 4 of those are mine (easy to fix), the rest is yours

You need to learn how to DEBUG your code and fix it. HERE is a video from the start...

Some notes:

Tick on a Breat at point. Then the program breaks at the error line. You need to use "Last Break Source" to get there.

Sometimes it does not locate the line... or your problem is not clear...

... then make some break "Toggle break" icon(s), add at least *LAST-VALUE* to the Watch and go one step by another to see what the program evaluates, whether it's good or not.

Also, if you have a large sets of items in the drawing, remove most of it - keep just 2-3 items of its kind so that you don't drown in endless loops of similar items... 

One more, it's good to rewrite '(lambda ...) into (function (lambda ...)) - will step thru the function easier.

Here are some comments on the code. It's just a screenshot taken just before the inevitable crash...

Once you fix all the errors, then it requires some optimization.

BTW the last 3 of yours check the command-line listing. They don't stop the code from running but make the code terribly slow.

Enjoy the next few hours of quality time spent... 

[komondormrex]

@dlbsurveysuk 

just wondering, maybe u need selecting texts in near proximity to insertion points of inserts with regard to fuzziness set?

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

(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_sset insert_ename insert_point
				 proximity_text_sset
			  )
	(setq insert_sset_ptre (ssget "_x" '((2 . "ptre")))
		  insert_index -1
		  proximity_texts_sset (ssadd)
	)
	(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_sset (ssadd (ssname proximity_text_sset 0) proximity_texts_sset))
		)
	)
	(sssetfirst nil proximity_texts_sset)
	proximity_texts_sset
)

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

[Kent1Cooper]

---

@dlbsurveysuk wrote:

Should the second (if be (8."TEXT") ? ....

---

That kind of entry requires spaces on either side of the period:  (8 . "TEXT")

[Sea-Haven]

 Few comments

If you use CIV3D or similar civil package you can have a point with a description label,

Reading a points file can match X,Y,Z,code and insert block need correct lisp,

I use a dynamic block that has 2 items a circle for the trunk dia and the second the spread dia so matches you code style,

You would though need multiple dynamic blocks if you want different look for trees.

I would take a step back and look seriously at how your importing your points.

In image all blocks were inserted automatically by reading the pt,X,Y,Z,code 

[dlbsurveysuk]

I'm a one man band and only have standard AutoCad (was thinking about Bricscad but I use point clouds a lot and currently Bricscad doesn't have all the same features/performance) . Civil3D costs an extra £1000 a year here.

All the data is collected by Leica Captivate with a LSS codelist, and run through LSS DTM software to calc traverse, contours etc. This is then exported as a DXF into AutoCad. (reason for LSS is it's UK based and cheap (£250).

When collecting tree info on site the LSS tree code has a set of attributes that will then auto draw a tree in the LSS software, but...

The Leica logger process of going through all the attributes is clunky and annoying, it's easier and faster to just type a single note (G-S-H-TYPE), and the LSS software has a particular style/look to the drawings it produces, which isn't what I want.

So after a minimum of processing I export the raw survey into AutoCad. On a lot of jobs I also now collect a lot of my topo info through scanning with a BLK360, with just control targets and a smattering of traditional topo with the theodolite, so I combine in AutoCad for drawing/editing.

All level cross blocks etc. circles, and rectangles are automatic.

I've written a lisp routine that converts everything exported from LSS into the style I want, the trees are the last thing that hasn't been fully automated. Currently I have to run the Lisp TREN and pick each tree point and note to auto draw the trees one by one. Once that is sorted it'll be as efficient as what you describe, without having to follow LSS standards or buying Civil3D.

I have a similar situation with point clouds - I just use Leica Register 360 BLK Edition (the cheapest) to process them and export to AutoCad. Then have the Point Cloud Cropping Tools addin (one off £40!), and a series of my own Lisp routines to work with them, whereas I know other people who have additional software such as Cloudworx (which also costs an extra £1000 a year).

I do use dynamic blocks (windows, doors etc) when drawing building plans and elevations + I have a block with a number attribute that I insert to all target points using a Lisp routine that auto numbers them, then use Dataextraction to export the numbered target x,y,z points into Register 360. But I can't export blocks with attributes from LSS to AutoCad.

It's all about having my own system using minimal expensive software while still keeping up efficiency.

[dlbsurveysuk]

Yeah, it's correct in the actual code.