SEEK A LISP TO EXTRACT BEAM MARK AND CORRESPONDING PAGE NO.

SEEK A LISP TO EXTRACT BEAM MARK AND CORRESPONDING PAGE NO.

skchui6159
Advocate Advocate
605 Views
12 Replies
Message 1 of 13

SEEK A LISP TO EXTRACT BEAM MARK AND CORRESPONDING PAGE NO.

skchui6159
Advocate
Advocate

skchui6159_0-1749198307067.png

CAN anyone EXTRACT above USING LISP TO csv. file? There are batch of data are need to be extract.

Sample:

Beam , Page

ACRB079c*, (4)

 

Thank you very much!

 

0 Likes
Accepted solutions (4)
606 Views
12 Replies
Replies (12)
Message 2 of 13

devitg
Advisor
Advisor

@skchui6159 Please upload a sample as you need the data to be show

0 Likes
Message 3 of 13

skchui6159
Advocate
Advocate

@devitg It is the sample file for my queries and the dwg has been updated.

skchui6159_0-1749300026924.png

skchui6159_1-1749300042628.png

if the page no. is showing -1, or -2... is also ok

 

0 Likes
Message 4 of 13

Moshe-A
Mentor
Mentor
Accepted solution

@skchui6159  hi,

 

check this ACRB2CSV command.

 

Any good reason why your texts object are set with backwards = yes and upside down = yes?  what does this serve???

 

Note:

the program match pairs of texts ACRBnnn with (n) by distance. make sure the right (n) is most close to ACRBnnn.

on my excel a text field starting with '(' means starting some function so i guess you will have to change them to [] or something else

 

enjoy

Moshe

 

(defun c:acrb2csv (/ text_in_parenthesis text_middle_point entity_list	; local functions
		     closet_text filter_numbers build_data 		; local functions
		     fname ss0 ss1 ss2 ename elist text data1 data2 data3 f pair text1 text2)

 ; return t if text value is (...)
 (defun text_in_parenthesis (str) 
   (and
     (vl-string-position (ascii "(") str 0 nil)
     (vl-string-position (ascii ")") str 0 t)
   )
 ); text_in_parenthesis


 ; return text middle point
 (defun text_middle_point (ename / elist box^ b0 b1 p10 rot)
  (setq elist (entget ename))
  (setq box^ (textbox elist))
  (setq p10 (cdr (assoc '10 elist)))
  (setq rot (cdr (assoc '50 elist)))

  (if (= (logand (cdr (assoc '71 elist)) 4) 4)
   (setq box^ (reverse box^))
  )
   
  (setq b0 (car box^) b1 (cadr box^))
  (setq b0 (polar (polar p10 rot (car b0)) (- rot (/ pi 2)) (cadr b0)))
  (setq b1 (polar (polar p10 rot (car b1)) (+ rot (/ pi 2)) (cadr b1)))

  (mapcar '* (mapcar '+ b0 b1) (list 0.5 0.5))
 ); text_middle_point

  
 ; generate a list of (ename pt)
 (defun entity_list (ss)
  (mapcar
    (function
      (lambda (ename)
       (list ename (text_middle_point ename))
      )
    ); function
    (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
  ); mapcar
 ); entity_list 


 ; get the closet text to ACRBxxxx
 (defun closet_text (d1 data2)
   (car
     (vl-sort
       (mapcar
	 (function
	   (lambda (d2)
	     (list (distance (cadr d1) (cadr d2)) d2)
	   )
	 ); function
         data2
       ); mapcar
      (function (lambda (e0 e1) (< (car e0) (car e1))))
     ); vl-sort
   ); car
 ); closet_text


 ; return numbers of string
 (defun filter_numbers (str)
  (atoi
    (vl-list->string
      (vl-remove-if
       'not
        (mapcar
          (function
            (lambda (n)
             (if (and (>= n 48) (<= n 57)) n)
            )
          ); function
          (vl-string->list str)
        ); mapcar
      ); vl-remove-if
    ); vl-list->string
  ); atoi
 ); filter_numbers


 (defun build_data (data1 data2)
  (vl-remove-if
    'not
    (mapcar
      (function
        (lambda (d1 / d3 text)
	  (setq text (cdr (assoc '1 (entget (car d1)))))
          (if (setq d3 (closet_text d1 data2))
           (list (filter_numbers text) d1 (cadr d3))
          )
        ); lambda
      ); function
      data1
    ); mapcar
  ); vl-remove-if
 ); build_data

  
 ; here start c:acrb2csv
 (if (and
       (setq fname (getfiled "Create csv data file" "" "csv" 9))
       (setq ss0 (ssget '((0 . "text,mtext"))))
     )
  (progn
   (setq ss1 (ssadd))
   (setq ss2 (ssadd))
   
   (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss0)))
    (setq elist (entget ename))
    (setq text (cdr (assoc '1 elist)))

    (if (text_in_parenthesis text)
     (ssadd ename ss2)
     (ssadd ename ss1)
    ); if
   ); foreach

   (setq data1 (entity_list ss1))
   (setq data2 (entity_list ss2))
   (setq data3 (build_data data1 data2))

   ; Creating CSV file
   (if (setq f (open fname "w")) ; open excel file
    (progn
     (princ (strcat "\nCreating " fname " file."))
     (write-line "BEAM,Page no" f) ; excel file header
     
     (foreach pair (mapcar 'cdr (vl-sort data3 (function (lambda (e0 e1) (< (car e0) (car e1))))))
      (setq text1 (cdr (assoc '1 (entget (caar pair)))))
      (setq text2 (cdr (assoc '1 (entget (caadr pair)))))
       
      (write-line (strcat text1 "," text2) f)
     ); foreach
     
     (setq f (close f))  ; close excel file
    ); progn
   ); if 
   
  ); progn
 ); if

 (princ)
); c:acrb2csv

.

 

Message 5 of 13

skchui6159
Advocate
Advocate

@Moshe-A Thank you very much for your help!🙏 That can solve lot of problem for my orginal key plan checking!. 😁

 

Reply with "Any good reason why your texts object are set with backwards = yes and upside down = yes?  what does this serve???". Because the texts objects are created by different person. May be they use mirror function. I dont know.😰

0 Likes
Message 6 of 13

komondormrex
Mentor
Mentor
Accepted solution

yet another one. outputs pairs  to autocad console.

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

(defun clean_list (_list / cleaned_list)
  (while (setq 1st_element (car _list))
    (setq cleaned_list (append cleaned_list (list (car _list)))
	  _list (vl-remove-if '(lambda (element) (equal element 1st_element)) (setq _list (cdr _list)))   
    )
  )
  cleaned_list
)

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


(defun find_closest_to (text list_to)
  (list (vla-get-textstring text)
	(vla-get-textstring (cdar (vl-sort (mapcar '(lambda (text_to) (cons (distance (vlax-get text 'insertionpoint)
										      (vlax-get text_to 'insertionpoint)
									    )
									    text_to)) list_to
						                      )
				          '(lambda (pair_1 pair_2) (< (car pair_1) (car pair_2))) 
			          )
			    )
	)
  )
)

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


(defun c:find_beam_pairs (/ beam_text_list angle_list beam_page_list beam_type_list)
  (setq beam_text_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "text") (1 . "(*),ACRB*")))))))
        angle_list (vl-sort (clean_list (mapcar 'vla-get-rotation beam_text_list)) '<)
        beam_page_list (mapcar '(lambda (_angle) (vl-remove-if-not '(lambda (text) (and (equal _angle (vla-get-rotation text))
										        (wcmatch (vla-get-textstring text) "(*)")
										   )
								    )
						  		    beam_text_list
						  )
			         )
			         angle_list
		        )
        beam_type_list (mapcar '(lambda (_angle) (vl-remove-if-not '(lambda (text) (and (equal _angle (vla-get-rotation text))
										        (wcmatch (vla-get-textstring text) "ACRB*")
										   )
								    )
						                    beam_text_list
					         )
				)
			        angle_list
		       )
 )
 (mapcar '(lambda (pair) (princ (cadr pair)) (princ ",") (princ (car pair)) (princ "\n"))
	 (cons '("BEAM" "\nPage No")
		 (vl-sort (apply 'append
				 (mapcar '(lambda (page_sublist type_sublist) (mapcar '(lambda (page_entry) (find_closest_to page_entry type_sublist))
										        page_sublist
									       )
					  )  
					  beam_page_list
					  beam_type_list
				 )
			  )
			 '(lambda (beam_1 beam_2) (< (cadr beam_1) (cadr beam_2)))
		 )
	 )
 )
 (princ)
)
Message 7 of 13

skchui6159
Advocate
Advocate

@komondormrex Thank you very much for sharing😉, it is good for the fast checking!

@Moshe-A @komondormrex 

Can I have reserve version for input the data of csv to autoCAD (may be need to have upgrade of the pervious csv for the update?). Then entmod the above object-page no.😅 Thank you!

skchui6159_0-1749391046391.png

 

0 Likes
Message 8 of 13

Moshe-A
Mentor
Mentor

@skchui6159  hi,

 

Your origin drawing data are simple text objects and to match them require a lot of code work.

why don't you think of a better way? how about putting them together in combined object like a nice block with attributes.

 

put some thoughts on functionality as whole (run it manually or write it down) from start to top final.

 

??

 

Moshe

 

Message 9 of 13

skchui6159
Advocate
Advocate

@Moshe-A OK, Thank you very much!

0 Likes
Message 10 of 13

komondormrex
Mentor
Mentor
Accepted solution

check the following. load whole lisp code.

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

(defun get_csv_filename (/ csv_name_selected)
	(setq csv_name_selected (strcat (vlax-get (vla-get-activedocument (vlax-get-acad-object)) 'Path)
						   		 	 "\\"
									 (if (and csv_filename (findfile csv_filename)) (vl-filename-base csv_filename) "")
						  	)
	)
	(if (type acet-ui-getfile)
			(setq csv_filename (acet-ui-getfile "Select CSV file" csv_name_selected "csv" "" 2))
			(setq csv_filename (getfiled "Select CSV file" csv_name_selected "csv" 2))
	)
	(if (= "" csv_filename)
		nil
		csv_filename
	)
)

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

(defun string_to_list (input_string delimiter / delimiter_position output_list)
	(if (= 'str (type input_string))
		(progn
			(while (setq delimiter_position (vl-string-search delimiter input_string 0))
				(setq output_list (append output_list (list (substr input_string 1 delimiter_position)))
					  input_string (substr input_string (+ 2 delimiter_position))
				)
			)
			(append output_list (list input_string))
		)
		nil
	)
)

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

(defun read_csv ( csv_filename / csv_id csv_string read_csv_list)
  (setq csv_id (open csv_filename "r")
  		csv_string (read-line csv_id)
  )
  (while (setq csv_string (read-line csv_id))
    (setq read_csv_list (append read_csv_list (list (string_to_list csv_string ","))))
  )
  (close csv_id)
  read_csv_list
)

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

(defun clean_list (_list / 1st_element cleaned_list)
  (while (setq 1st_element (car _list))
    (setq cleaned_list (append cleaned_list (list (car _list)))
	  _list (vl-remove-if '(lambda (element) (equal element 1st_element)) (setq _list (cdr _list)))
    )
  )
  cleaned_list
)

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

(defun find_closest_to (text list_to)
  (list text
	(cdar (vl-sort (mapcar '(lambda (text_to) (cons (distance (vlax-get text 'insertionpoint)
								  (vlax-get text_to 'insertionpoint)
						        )
						        text_to
					          )
				)
				list_to
		       )
		      '(lambda (pair_1 pair_2) (< (car pair_1) (car pair_2)))
	      )
	)
  )
)

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

(defun c:find_beam_pairs (/ beam_text_list angle_list beam_page_list beam_type_list text_pair index_color)
  (setq beam_text_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "text") (1 . "(*),ACRB*")))))))
        angle_list (vl-sort (clean_list (mapcar 'vla-get-rotation beam_text_list)) '<)
        beam_page_list (mapcar '(lambda (_angle) (vl-remove-if-not '(lambda (text) (and (equal _angle (vla-get-rotation text))
										        (wcmatch (vla-get-textstring text) "(*)")
										   )
								    )
						  		    beam_text_list
						  )
			         )
			         angle_list
		        )
        beam_type_list (mapcar '(lambda (_angle) (vl-remove-if-not '(lambda (text) (and (equal _angle (vla-get-rotation text))
										        (wcmatch (vla-get-textstring text) "ACRB*")
										   )
								    )
						                    beam_text_list
					         )
				)
			        angle_list
		       )
	index_color 0
 )
 (mapcar '(lambda (pair) (princ (car pair)) (princ ",") (princ (cadr pair)) (princ "\n"))
	  (cons '( "\nBEAM" "Page No")
		 (vl-sort (apply 'append
				 	(mapcar '(lambda (type_sublist page_sublist) (mapcar '(lambda (type_entry) (mapcar 'vla-get-textstring
						    		   		   					   (progn
															     (setq text_pair (find_closest_to type_entry page_sublist)
																   index_color (1+ index_color)
															     )
															     (mapcar '(lambda (text) (vla-put-color text index_color))
																      text_pair
															     )
															     text_pair
															   )
					    			   						   )
						       					      )
						        				      type_sublist
					      					     )
				 		  	  )
				 		  	  beam_type_list
				 		  	  beam_page_list
				 	)
			  	  )
			     '(lambda (beam_1 beam_2) (< (car beam_1) (car beam_2)))
		 )
	  )
 )
 (princ)
)

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

(defun c:change_beam_pages (/ csv_filename csv_list beam_text_list angle_list beam_page_list beam_type_list beam_page_list text_pair new_page)
  	(if (and (setq csv_filename (get_csv_filename))
			 (setq csv_list (read_csv csv_filename))
		)
  	  	(progn
  			(setq beam_text_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "text") (1 . "(*),ACRB*")))))))
  			  	  angle_list (vl-sort (clean_list (mapcar 'vla-get-rotation beam_text_list)) '<)
  			  	  beam_page_list (mapcar '(lambda (_angle) (vl-remove-if-not '(lambda (text) (and (equal _angle (vla-get-rotation text))
  			  											    (wcmatch (vla-get-textstring text) "(*)")
  			  										   )
  			  									)
  			  							  		beam_text_list
  			  						 )
  			  				    )
  			  				    angle_list
  			  			    )
  			  	  beam_type_list (mapcar '(lambda (_angle) (vl-remove-if-not '(lambda (text) (and (equal _angle (vla-get-rotation text))
  			  											    (wcmatch (vla-get-textstring text) "ACRB*")
  			  										   )
  			  									)
  			  							                beam_text_list
  			  						     )
  			  				)
  			  				    angle_list
  			  			   )

  			  	beam_page_list (apply 'append
  			  				   (mapcar '(lambda (type_sublist page_sublist) (mapcar '(lambda (type_entry) (progn (setq text_pair (find_closest_to type_entry page_sublist))
  			  														     (list (vla-get-textstring (car text_pair)) (cadr text_pair))
  			  													  )
  			  											 )
  			  											 type_sublist
  			  										)
  			  					)
  			  					beam_type_list
  			  					beam_page_list
  			  				   )
  			  			   )
  			)
  			(foreach csv_row csv_list
  			  	(if (setq new_page (caddr csv_row)) (vla-put-textstring (cadr (assoc (car csv_row) beam_page_list)) (strcat "(" new_page ")"))
  			  	)
  	    	)
		)
 	)
 	(princ)
)

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

1. run find_beam_pairs. it will find and color each pair with 1-incremented index color starting 1 (red).

komondormrex_0-1749490543102.png

2. check if all pairs complete. beam ACRB072* has 2 pages near to it. i just moved its (4) page closer to insertion point to exclude missing pair.

komondormrex_1-1749490729993.png

 

3. run find_beam_pairs again to check every pair is correct.

komondormrex_2-1749490793552.png

4. run change_beam_pages to change each beam page according to Change to Page no. column in the csv file.

komondormrex_3-1749491013431.png

you've got it.

 

 

0 Likes
Message 11 of 13

Sea-Haven
Mentor
Mentor
Accepted solution

Two comments using a block would be a way better way to go, you can move the attribute via code or have visibility states for left, center and right.

 

Second comment for me I read and write direct to Excel or Libre Calc no need for a csv. That is 3 defuns.

0 Likes
Message 12 of 13

skchui6159
Advocate
Advocate

@komondormrex Thank you very much, it is exactly what I want. You got it complete 100%! thank!

@Sea-Haven Thank you for your sharing to write to csv. (Re: Why I am not write direct to excel? Because I find that there may not run easily in different version in autoCAD.😅 Write a block, it is good idea!

 

Cheer!

0 Likes
Message 13 of 13

Sea-Haven
Mentor
Mentor

Just another suggestion when making a page reference you could use a field that looks at an attribute in your title block in a layout think sheet X of Y, you can get that attribute value by providing say sheet number or layout name when making the (4). This way it's always up to date. I have a renumber sheets lisp so if move or add sheets the values are updated.

0 Likes