Select/Coordinates/Sort/Number/Write to text file - not working...

dlbsurveysuk · ‎02-05-2023

Erm. this code is a mess...

I need to make a selection set of a certain block.
Extract the coordinates of those blocks.
Sort them low to high by z.
Prefix each set of coordinates with a number incrementally from 1.
Annotate each block position on the drawing with that number.
Reorder each list row from NUM,X,Y,Z to NUM,Y,X,Z
Write the list to a csv text file

Text file example -

1,Y,X,Z
2,Y,X,Z
3,Y,X,Z
etc,

I've cobbled the code together a bit haphazardly, with a good helping of wrong, and guess what... It doesn't work.

Tried to test in VLIDE but get error "too many arguments:"

Have checked parenthesis.

Pretty sure the csv text file part is wrong but was just trying it to see what happened, although the routine never got going anyway...

(defun c:TNCL ()

  (setvar 'Cmdecho 1)

  (if (setq target_blocks (ssget "_X" '((0 . "INSERT") (2 . "PTAR"))))                                  ;;; check for and select blocks

      (repeat
            (setq i (sslength target_blocks))

            (setq target_coords (cdr (assoc 10 (entget (ssname target_blocks (setq i (1- i)))))))               ;;;  list of coordinates
            (setq target_coords_by_z (vl-sort target_coords (lambda (PT1 PT2) (< (caddr PT1) (caddr PT2)))))     ;;;  sort low to high by z
       )

       (setq CSV (open (strcat (getvar "dwgprefix") (getvar "dwgname") ".txt") "w"))                      ;;; open text file to write to

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

	              (setq xyz (entget (ssname target_coords_by_z i)))
                   (command "TEXT" xyz "" "" i)                                                                     ;;; TEXT count number at coordinates

                   (setq numb_list '(strcat i (ssname target_coords_by_z i)))                                    ;;; prefix list with count number

                       (setq NUM (car (ssname numb_list i)))                                                            ;;; separate items
                       (setq X (cadr (ssname numb_list i)))
                       (setq Y (caddr (ssname numb_list i)))
                       (setq Z (last (numb_list i)))

                       (setq list_to_export '(strcat NUM Y X Z))                                                          ;;; reorder items into a list

                   (write-line (ssname list_to_export i) CSV)                                                            ;;; write line of list to txt file
            )

           (close CSV)                                                                                                     ;;; close text file

  )

(princ)
)

Moshe-A · ‎02-05-2023

@dlbsurveysuk hi,

i added (progn) after the (if) and it's now load.

Moshe

(defun c:TNCL ()
 (setvar 'cmdecho 1)
 (if (setq target_blocks (ssget "_X" '((0 . "INSERT") (2 . "PTAR"))))                                  ;;; check for and select blocks
  (progn 
   (repeat (setq i (sslength target_blocks))
    (setq target_coords (cdr (assoc 10 (entget (ssname target_blocks (setq i (1- i)))))))               ;;;  list of coordinates
    (setq target_coords_by_z (vl-sort target_coords (lambda (PT1 PT2) (< (caddr PT1) (caddr PT2)))))     ;;;  sort low to high by z
   )

   (setq CSV (open (strcat (getvar "dwgprefix") (getvar "dwgname") ".txt") "w"))                      ;;; open text file to write to
   (repeat (setq i (sslength target_coords_by_z))
    (setq i (1- i))
    (setq xyz (entget (ssname target_coords_by_z i)))
    (command "TEXT" xyz "" "" i)                                                                     ;;; TEXT count number at coordinates
    (setq numb_list '(strcat i (ssname target_coords_by_z i)))                                       ;;; prefix list with count number
    (setq NUM (car (ssname numb_list i)))                                                            ;;; separate items
    (setq X (cadr (ssname numb_list i)))
    (setq Y (caddr (ssname numb_list i)))
    (setq Z (last (numb_list i)))
    (setq list_to_export '(strcat NUM Y X Z))                                                          ;;; reorder items into a list
    (write-line (ssname list_to_export i) CSV)                                                         ;;; write line of list to txt file
   ); repeat
   (close CSV)                                                                                          ;;; close text file
  ); progn
 ); if
  
 (princ)
)

paullimapa · ‎02-05-2023

this is a good start...at first glance, your initial error is with your first repeat function.

you'll need to create a list of all the xyz coordinates of the block like this:

(repeat
 (setq i (sslength target_blocks))
 (setq target_coords (append target_coords (list(cdr (assoc 10 (entget (ssname target_blocks (setq i (1- i))))))))) ;;; append to a list of coordinates
) ; repeat

then assuming your lambda function works run that after repeat:

(setq target_coords_by_z (vl-sort target_coords '(lambda (PT1 PT2) (< (caddr PT1) (caddr PT2)))))     ;;;  sort low to high by z

then you'll cycle through the list which is different than a selection set like this:

(repeat
 (setq i (length target_coords_by_z)) ; length of list

try these changes (not tested)

Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos

komondormrex · ‎02-06-2023

new one

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

(defun get_csv_filename (extension / output_name csv_filename)
	(setq output_name (strcat (vlax-get (vla-get-activedocument (vlax-get-acad-object)) 'path)
					   		  "\\"
							  (vl-filename-base (vlax-get (vla-get-activedocument (vlax-get-acad-object)) 'name))
					  )
	)
	(if (type acet-ui-getfile)
			(setq csv_filename (acet-ui-getfile "Enter CSV filename"
												output_name
												extension
												""
												1
							   )
			)
			(setq csv_filename (getfiled "Enter CSV filename"
										  output_name
										 extension
										 1
							   )
			)
	)
	(if (= "" csv_filename)
		nil
		csv_filename
	)
)

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

(defun c:mark_blocks (/ block_list block_object ename_index ignore_empty_sset block_sset insertion_point llc urc block_mark_point csv_filename_full
					  	csv_id
					 )
	(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
	(and
		(repeat (sslength (setq ename_index -1
								ignore_empty_sset (while (null (setq block_sset (vl-catch-all-apply 'ssget (list "_:L" '((0 . "insert") (2 . "ptar")))))))
								block_sset (cond
												(
													(vl-catch-all-error-p block_sset)
														(princ "\nCommand cancelled")
														(ssadd)
												)
												(
													t
														block_sset
												)
										   )
					   	  )
				)
			(setq block_object (vlax-ename->vla-object (ssname block_sset (setq ename_index (1+ ename_index))))
				  insertion_point (vlax-get block_object 'insertionpoint)
			)
			(vla-getboundingbox block_object 'llc 'ruc)
			(setq block_mark_point (mapcar '+ '(1 1 0) (vlax-safearray->list ruc))	;	markup text offset x=1, y=1, z=0 from right upper corner of block bounding box
				  block_list (append block_list (list (list insertion_point block_mark_point)))
			)
		)
		(progn
			(setq block_list (vl-sort block_list '(lambda (block_1 block_2) (< (caddar block_1) (caddar block_2)))))
			(if (setq csv_filename_full (get_csv_filename "csv"))
				(progn
					(setq csv_id (open csv_filename_full "w")
						  ename_index 0
					)
					(foreach block block_list
						(write-line (strcat (itoa (setq ename_index (1+ ename_index)))
										   	","
										   	(vl-princ-to-string (cadar block))
										   	","
										   	(vl-princ-to-string (caar block))
										   	","
										   	(vl-princ-to-string (caddar block))
									)
									csv_id
						)
						(vla-put-layer
							(vla-addtext (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
										 (itoa ename_index)                                                                         ;	markup text string
										 (vlax-3d-point (cadr block))
										 (getvar 'textsize)                                                                         ;	markup text size
							)
							(getvar 'clayer)                                                                                        ;	markup text layer
						)
					)
					(close csv_id)
					(princ (strcat "\nFile \"" csv_filename_full "\ has been written." ))
				)
				(princ "\nCommand cancelled")
			)
		)
	)
	(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
	(princ)
)

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

dlbsurveysuk · ‎02-06-2023

Hi, thanks for this.

It is failing with "error: Automation Error. Invalid input" at line 82

(getvar 'textsize)

No idea why...

dlbsurveysuk · ‎02-06-2023

Hi, I've implemented your suggestions. It now loads and runs but fails at the lambda function (not sure why). I've tried the routine without the lambda sorting line and it fails at

(setq xyz (entget (ssname target_coords i)))

I'm a bit lost as to what code I should be using re lists as opposed to selection sets.

Thanks

(defun c:TNCL ()

  (setvar 'Cmdecho 1)

  (if (setq target_blocks (ssget "_X" '((0 . "INSERT") (2 . "PTAR"))))                                            ;;; check for and select blocks
    (progn
      (repeat
            (setq i (sslength target_blocks))
            (setq target_coords (append target_coords (list(cdr (assoc 10 (entget (ssname target_blocks (setq i (1- i)))))))))  ;;;  append to a list of coordinates
       )

;;;          (setq target_coords_by_z (vl-sort target_coords (lambda (PT1 PT2) (< (caddr PT1) (caddr PT2)))))     ;;;  sort low to high by z


       (setq CSV (open (strcat (getvar "dwgprefix") (getvar "dwgname") ".txt") "w"))                      ;;; open text file to write to

            (repeat
                (setq i (length target_coords))
                (setq i (1- i))

	   (setq xyz (entget (ssname target_coords i)))
                   (command "TEXT" xyz "" "" i)                                                                                     ;;; TEXT count number at coordinates

                   (setq numb_list '(strcat i (target_coords i)))                                       ;;; prefix list with count number

                       (setq NUM (car (ssname numb_list i)))                                                                  ;;; separate items
                       (setq X (cadr (ssname numb_list i)))
                       (setq Y (caddr (ssname numb_list i)))
                       (setq Z (last (ssname numb_list i)))

                       (setq list_to_export '(strcat NUM Y X Z))                                                                ;;; reorder items into a list

                   (write-line (list_to_export i) CSV)                                                                  ;;; write line of list to txt file
            )

           (close CSV)                                                                                                                         ;;; close text file
    )
  )

(princ)
)

ВeekeeCZ · ‎02-06-2023

Here's your modified code.

The workflow is

* make a selection set

* create a LIST

* sort the LIST

* work with the LIST (not a selection set anymore!)

* save the LIST

(vl-load-com)

(defun c:TNCL ( / *error* CSV ss_target_blocks lst_target_coords i )
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if CSV (close CSV))
    (princ))
  
  (if (setq ss_target_blocks (ssget "_X" '((0 . "INSERT") (2 . "PTAR"))))
    (repeat (setq i (sslength ss_target_blocks))
      (setq lst_target_coords (cons (cdr (assoc 10 (entget (ssname ss_target_blocks (setq i (1- i)))))) lst_target_coords))))
  
  (if (and lst_target_coords
	   (setq lst_target_coords (vl-sort lst_target_coords '(lambda (PT1 PT2) (< (caddr PT1) (caddr PT2)))))
	   (setq CSV (open (strcat (getvar "dwgprefix") (getvar "dwgname") ".txt") "w"))                      ;;; open text file to write to
	   (setq i 0) 
	   )
    (foreach coords lst_target_coords
      (setq i (1+ i))
      (command "TEXT" "_non" coords "" "" (itoa i))                                                                     ;;; TEXT count number at coordinates
      
      (write-line
	(strcat (itoa i) ","
		(rtos (car coords) 2 4) ","
		(rtos (cadr coords) 2 4) ","
		(rtos (caddr coords) 2 4))
	CSV)
      ))
  
  (if CSV (close CSV))
  (princ)
  )

Notes to your code.

(defun c:TNCL ()

  (setvar 'Cmdecho 1)

  (if (setq target_blocks (ssget "_X" '((0 . "INSERT") (2 . "PTAR"))))                                  ;;; check for and select blocks

      (repeat
            (setq i (sslength target_blocks))

            (setq target_coords (cdr (assoc 10 (entget (ssname target_blocks (setq i (1- i)))))))               ;;;  list of coordinates
            (setq target_coords_by_z (vl-sort target_coords (lambda (PT1 PT2) (< (caddr PT1) (caddr PT2)))))    ;; this is highly inefficient idea . Collect them all to a LIST, THEN sort them all afterward. Once! Missing '
       )

       (setq CSV (open (strcat (getvar "dwgprefix") (getvar "dwgname") ".txt") "w"))                      ;;; open text file to write to

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

	              (setq xyz (entget (ssname target_coords_by_z i))) ;; not the way to get coordinates.
                   (command "TEXT" xyz "" "" i)        ;; TEXT needs a string! Not an integer                                                             ;;; TEXT count number at coordinates

                   (setq numb_list '(strcat i (ssname target_coords_by_z i)))   ;; why ' ?  The strcat creates a STRING not a LIST. You need to use CONS or LIST

                       (setq NUM (car (ssname numb_list i)))     ;;; ssname??? it's not a selection set!!!                      
                       (setq X (cadr (ssname numb_list i)))
                       (setq Y (caddr (ssname numb_list i)))
                       (setq Z (last (numb_list i)))

                       (setq list_to_export '(strcat NUM Y X Z))       ;; again... strcat is for stings....        

                   (write-line (ssname list_to_export i) CSV)                                                            ;;; write line of list to txt file
            )

           (close CSV)                                                                                                     ;;; close text file

  )

(princ)
)

komondormrex · ‎02-06-2023

try to replace line for number, eg 2.5 or else text height number

dlbsurveysuk · ‎02-06-2023

Woah! Thanks! That works perfectly.

I can see now I should have been thinking of the "foreach" function, Also missed (vl-load-com), and variable definitions. Yes the initial workflow/logic is important.

I'll probably modify this slightly to accept a user defined block name selection as I have at least two scenarios for using this routine.

Thanks again.

dlbsurveysuk · ‎02-06-2023

Oh. just saw your notes to my code. That's very helpful. Thanks.

dlbsurveysuk · ‎02-07-2023

A few alterations and additions to this -

Added text alerts for usability.
Works for any user entered block name.
Multiple list/sort order options (corrected to YXZ order as per intial requirements).
Altered text layer, size, and justification for numbering.

Very helpful routine. Faster/smoother workflow, and reduced possibilities for user error - no more manual insertion of blocks with number attribute, and use of dataextraction command with manual swap of x and y columns and additional edit of csv file.

Probably could be more efficient code re the sub-routines...

Thanks for all the help.

(vl-load-com)

(defun c:TNCL ( / *error* CSV blk blkname found name LYR ss_target_blocks lst_target_coords i )
  
       (defun *error* (errmsg)
         (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
         (princ (strcat "\nError: " errmsg)))
         (if CSV (close CSV))
         (if LYR (setvar "CLAYER" LYR))
       (princ))

         (setq LYR (getvar "CLAYER"))
         (command "LAYER" "M" "TEXT" "")

   (alert "This will create a numbered csv text file of control point coordinates, from block insertion points, and correspondingly number the points on the drawing ...")

   (if (and (setq blkname (getstring T "\n Enter block name :")) (setq found (tblsearch "BLOCK" blkname))
           (setq ss_target_blocks (ssadd)
                    ss (ssget "_x" '((0 . "INSERT")))
   ))

     (progn

        (repeat
             (setq i (sslength ss))
             (setq name (vla-get-effectivename (vlax-ename->vla-object (setq blk (ssname ss (setq i (1- i)))))))

                (if (eq (strcase blkname) (strcase name))
                    (ssadd blk ss_target_blocks)
           ))
                (if ss_target_blocks
                    (sssetfirst nil ss_target_blocks)
           ))

                  (cond ((not blkname)      (princ "\n Missed name of block ***"))
                            ((not found)           (princ "\n Block not found in drawing !!!"))
                            (t                           (princ "\n Couldn't find any block !!! "))
                  )
       )

       (repeat (setq i (sslength ss_target_blocks))
         (setq lst_target_coords (cons (cdr (assoc 10 (entget (ssname ss_target_blocks (setq i (1- i)))))) lst_target_coords)))

           (initget "XYZ(ENZ)Standard YXZ(NEZ)CycloneRegister360 ZXY(ZEN)Rectification")
           (setq LTS (cond ((getkword "\nChoose [XYZ(ENZ)Standard/YXZ(NEZ)CycloneRegister360/ZXY(ZEN)Rectification] <YXZ(NEZ)CycloneRegister360>: ")) ("YXZ(NEZ)CycloneRegister360")))

                (cond ((= LTS "XYZ(ENZ)Standard")                     (XYZENZ))
	          ((= LTS "YXZ(NEZ)CycloneRegister360")   (YXZNEZ))
	          ((= LTS "ZXY(ZEN)Rectification")                (ZXYZEN))
	)

          (if CSV
               (progn 
               (alert "Target coordinates file saved.") (close CSV)    
          )
)

(setvar "CLAYER" LYR)
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun XYZENZ ()            ;; sorted by x
 
           (if (and lst_target_coords
	   (setq lst_target_coords (vl-sort lst_target_coords '(lambda (PT1 PT2) (< (car PT1) (car PT2)))))
	   (setq CSV (open (strcat (getvar "dwgprefix") "XYZ-control-coordinates.txt") "w"))
	   (setq i 0)
           )
    (foreach coords lst_target_coords  (setq i (1+ i))
          (command "TEXT" "TC" coords 0.2 "" (itoa i))
      
          (write-line
	(strcat (itoa i) ","
	           (rtos (car coords) 2 3) ","
                           (rtos (cadr coords) 2 3) ","
	           (rtos (caddr coords) 2 3))
          CSV)
      ))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun YXZNEZ ()             ,,, sorted by z
 
           (if (and lst_target_coords
	   (setq lst_target_coords (vl-sort lst_target_coords '(lambda (PT1 PT2) (< (caddr PT1) (caddr PT2)))))
	   (setq CSV (open (strcat (getvar "dwgprefix") "YXZ-control-coordinates.txt") "w"))
	   (setq i 0)
           )
    (foreach coords lst_target_coords  (setq i (1+ i))
          (command "TEXT" "TC" coords 0.2 "" (itoa i))
      
          (write-line
	(strcat (itoa i) ","
                           (rtos (cadr coords) 2 3) ","
	           (rtos (car coords) 2 3) ","
	           (rtos (caddr coords) 2 3))
          CSV)
      ))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun ZXYZEN ()            ;;; sorted by z
 
           (if (and lst_target_coords
	   (setq lst_target_coords (vl-sort lst_target_coords '(lambda (PT1 PT2) (< (caddr PT1) (caddr PT2)))))
	   (setq CSV (open (strcat (getvar "dwgprefix") "ZXY-control-coordinates.txt") "w"))
	   (setq i 0)
           )
    (foreach coords lst_target_coords  (setq i (1+ i))
          (command "TEXT" "TC" coords 0.2 "" (itoa i))
      
          (write-line
	(strcat (itoa i) ","
	           (rtos (caddr coords) 2 3) ","
	           (rtos (car coords) 2 3) ","
                           (rtos (cadr coords) 2 3))
          CSV)
      ))
)

ВeekeeCZ · ‎02-13-2023

This is what I would do. Just slightly tested.

dlbsurveysuk · ‎02-16-2023

Thanks for doing this. It looks much more compact and efficient. Unfortunately it doesn't seem to work here. On my test drawing after entering the block name "PTAR" it selects a different block name "PBUI", then after choosing YXZ for the output, nothing is exported. I'll try and diagnose it later. Thanks again.

Community

Select/Coordinates/Sort/Number/Write to text file - not working...

Select/Coordinates/Sort/Number/Write to text file - not working...

Select/Coordinates/Sort/Number/Write to text file - not working...