Lisp to export lines colors and texts beside them to excel

Lisp to export lines colors and texts beside them to excel

hythamthelove
Advocate Advocate
2,110 Views
23 Replies
Message 1 of 24

Lisp to export lines colors and texts beside them to excel

hythamthelove
Advocate
Advocate

Hello everyone,

i want a lisp to export all selected lines colors and also export texts beside them to excel. You can find below photos of the lines and texts in autocad and the table i want in excel, also DWG file will be attached for reference. If it is hard to get texts beside the lines, i could move texts to be in the line itself.

Thanks in advance

 

hythamthelove_0-1654977059506.pnghythamthelove_1-1654977084586.png

 

0 Likes
Accepted solutions (1)
2,111 Views
23 Replies
Replies (23)
Message 2 of 24

ВeekeeCZ
Consultant
Consultant

What is "beside" them. Post some cut-off from real dwg. Not a "legend" if that is.

And save that excel file with that example to *.csv and post it too.

Message 3 of 24

hythamthelove
Advocate
Advocate

actually this is exactly the case, i have some lines and some texts next to it (this is not a legend or something this is the actual case) as attached in the dwg, but of course they are not 3 lines and 3 texts only they are alot i am just bringing a sample but all of them are in the same format. The excel or csv i want is as attached here

hythamthelove_1-1655028633106.png

 

 

0 Likes
Message 4 of 24

ВeekeeCZ
Consultant
Consultant

post the csv

0 Likes
Message 5 of 24

hythamthelove
Advocate
Advocate

here it is

0 Likes
Message 6 of 24

ВeekeeCZ
Consultant
Consultant

Here you go. Not as simple as you might think.

 

(vl-load-com)

(defun c:ExportToCsv ( / *error* f LM:ACI->RGB s i e d st sl)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if f (close f))
    (princ))
  
  
  ;; Lee Mac ;; http://www.lee-mac.com/colourconversion.html#truaci
  (defun LM:ACI->RGB ( c / o r )
    (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
      (progn
	(setq r (vl-catch-all-apply '(lambda ( ) (vla-put-colorindex o c) (list (vla-get-red o) (vla-get-green o) (vla-get-blue o)))))
	(vlax-release-object o)
	(if (vl-catch-all-error-p r)
	  (prompt (strcat "\nError: " (vl-catch-all-error-message r)))
	  r))))
  
  ; ----------------------------------------
  
  (if (setq s (ssget '((0 . "LWPOLYLINE,LINE,*TEXT"))))
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i)))
	    d (entget e))
      (if (wcmatch (setq y (cdr (assoc 0 d))) "*TEXT")
	(setq st (cons (cons (caddr (assoc 10 d)) (getpropertyvalue e (if (= "TEXT" y) "StringText" "Text"))) st))
	(setq sl (cons (cons (caddr (assoc 10 d)) (if (wcmatch (setq c (getpropertyvalue e "Color")) "*`,*")
						    c
						    (substr (apply 'strcat (mapcar '(lambda (x) (strcat "," (itoa x))) (LM:ACI->RGB (atoi c)))) 2)))
		       sl)))))
  (if (and st sl
	   (setq f (open (strcat (getvar 'DWGPREFIX) (vl-string-right-trim ".dwg" (getvar 'DWGNAME)) "-Export.csv") "a"))
	   (write-line "Color,Text" f)
	   )
    (foreach e (vl-sort sl '(lambda (e f) (> (car e) (car f))))
      (write-line (setq l (strcat "\"" (cdr e) "\","
				  (vl-string-trim " " (cdar (vl-sort st '(lambda (g h) (< (abs (- (car e) (car g))) (abs (- (car e) (car h)))))))))))
      (write-line l f)))
  (*error* "end"))

 

0 Likes
Message 7 of 24

hythamthelove
Advocate
Advocate

thank you for your efforts really appreciated. I tried the lisp but it gives me this error "ADS request error" do you know how to solve this problem ?

 

0 Likes
Message 8 of 24

ВeekeeCZ
Consultant
Consultant

Does it fail on the file you posted? No issues here.

If on a different file, you need to post it. I won't be able to fix it without seeing the issue.

0 Likes
Message 9 of 24

calderg1000
Mentor
Mentor

Regards @hythamthelove 

To start, here is my proposal, tested in the example file. Please select only the polylines

 

(vl-load-com)
(defun c:sst (/ f of s sn svn p1 p2 tx tf)
  (setq f  (getfiled "\nEnter name File:" "" "csv" 1)
        of (open f "w")
  )
  (setq s (ssget '((0 . "lwpolyline"))))
  (repeat (setq i (sslength s))
    (setq sn  (ssname s (setq i (1- i)))
          svn (vlax-ename->vla-object sn)
          ct  (vla-get-truecolor svn)
    )
    (setq p1 (cdr (assoc 10 (entget sn)))
          p2 (polar p1 0 5400)
    )
    (setq tx (ssget "_f" (list p1 p2) '((0 . "*text")))
          tf (substr (cdr (assoc 1 (entget (ssname tx 0)))) 7)
    )
    (write-line (strcat (col ct) ";" tf) of)
  )
  (close of)
)
(defun col (c)
  (vl-string-right-trim
    ","
    (apply 'strcat
           (mapcar '(lambda (x) (strcat (itoa (vlax-get c x)) ","))
                   '(red green blue)
           )
    )
  )
)

 

 


Carlos Calderon G
EESignature
>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

0 Likes
Message 10 of 24

hythamthelove
Advocate
Advocate

Thank you for your effort, i tried it several times, it sometimes works and sometimes gets no values for the lines.

Here it the file i test on for reference

0 Likes
Message 11 of 24

hythamthelove
Advocate
Advocate

i actually figured out the problem, when the color is red or yellow or any of these colors the lisp stuck, otherwise it works great. Here is the file i use

0 Likes
Message 12 of 24

ВeekeeCZ
Consultant
Consultant

Good! I'll fix that tomorrow.

0 Likes
Message 13 of 24

calderg1000
Mentor
Mentor

Dear @hythamthelove 

I made some adjustments, you had texts that were not in the selection line and with different configuration.
Tested on the new file provided. Please select only the polylines by 2 points (Fence) from top to bottom.

 

(vl-load-com)
(defun c:sst (/ f of s ps1 i sn svn ct p1 p1b p2 p2b tx tt ltx tf)
  (princ "\nSelect polylines by FENCE:")
  (setq f  (getfiled "\nEnter name File:" "" "csv" 1)
        of (open f "w")
  )
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (if
    (setq s (ssget "_f"
                   (list (setq ps1 (getpoint "\nPick Point 1:"))
                         (getpoint "\nPick Point 2:" ps1)
                   )
                   '((0 . "lwpolyline"))
            )
    )
     (progn
       (setq i 0)
       (repeat (sslength s)
         (setq sn  (ssname s i)
               svn (vlax-ename->vla-object sn)
               ct  (vla-get-truecolor svn)
         )
         (setq p1  (cdr (assoc 10 (entget sn)))
               p1b (list (car p1) (- (cadr p1) 250))
               p2  (polar p1 0 5400)
               p2b (list (car p2) (+ (cadr p2) 250))
         )
         (setq tx  (ssget "_c" p1b p2b '((0 . "*text")))
               tt  (cdr (assoc 1 (entget (ssname tx 0))))
               ltx (vl-string->list tt)
         )
         (setq i (1+ i))
         (if (= (nth 0 ltx) 92)
           (setq tf (substr tt 7))
           (setq tf tt)
         )
         (write-line (strcat (col ct) ";" tf) of)
       )
       (close of)
     )
  )
  (setvar 'osmode osm)
  (princ)
)
(defun col (c)
  (vl-string-right-trim
    ","
    (apply 'strcat
           (mapcar '(lambda (x) (strcat (itoa (vlax-get c x)) ","))
                   '(red green blue)
           )
    )
  )
)

 

 


Carlos Calderon G
EESignature
>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

Message 14 of 24

Sea-Haven
Mentor
Mentor

Another method is just select all lines and text, and use a sorted Y value to make pairs of a line and text. This would get round the problem of the offset to text varies.

 

Will add "to do list" has a few now.

0 Likes
Message 15 of 24

hythamthelove
Advocate
Advocate

thank you for your reply. i will give it a try thank you so much

0 Likes
Message 16 of 24

hythamthelove
Advocate
Advocate

ok waiting for you. thanks for your help

0 Likes
Message 17 of 24

ВeekeeCZ
Consultant
Consultant
Accepted solution

Ok, thx. Thy the code below, it should be ok.

 

Anyway, interestingly my original code works fine at both my stations. Just for the future, would you post a command-line listing of returns of these two expressions? Try polylines with the assigned index color, and then change it to TrueColor and repeat both expressions.

 

(dumpallproperties (car (entsel)))

(getpropertyvalue (car (entsel)) "Color")

 

so please 4 listings. thx. also what Acad version do you use? English or not?

 

(vl-load-com)

(defun c:ExportToCsv ( / *error* f s i e d st sl tc)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if f (close f))
    (princ))
    
  ; ----------------------------------------
  
  (if (setq s (ssget '((0 . "LWPOLYLINE,LINE,*TEXT"))))
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i)))
	    d (entget e))
      (if (wcmatch (setq y (cdr (assoc 0 d))) "*TEXT")
	(setq st (cons (cons (caddr (assoc 10 d)) (getpropertyvalue e (if (= "TEXT" y) "StringText" "Text"))) st))
	(setq tc (vla-get-truecolor (vlax-ename->vla-object e))
	      sl (cons (cons (caddr (assoc 10 d)) 
			     (substr (apply 'strcat (mapcar '(lambda (x) (strcat "," (itoa (vlax-get tc x)))) '(red green blue))) 2))
		       sl)))))
  (if (and st sl
	   (setq f (open (strcat (getvar 'DWGPREFIX) (vl-string-right-trim ".dwg" (getvar 'DWGNAME)) "-Export.csv") "a"))
	   (write-line "Color,Text" f)
	   )
    (foreach e (vl-sort sl '(lambda (e f) (> (car e) (car f))))
      (write-line (setq l (strcat "\"" (cdr e) "\","
				  (vl-string-trim " " (cdar (vl-sort st '(lambda (g h) (< (abs (- (car e) (car g))) (abs (- (car e) (car h)))))))))))
      (write-line l f)))
  (*error* "end"))

 

Message 18 of 24

hythamthelove
Advocate
Advocate

I tried them now and they work perfectly in all cases. Thank you so much for your efforts really appreciated

0 Likes
Message 19 of 24

ВeekeeCZ
Consultant
Consultant

Good, glad to help.

I'm still interested in those listings. Would you post them? thx.

0 Likes
Message 20 of 24

hythamthelove
Advocate
Advocate

That is a mix of both index colors and true colors.

 

Command: EXPORTTOCSV
54 found
"46,149,209",7.32
"210,45,188",14.63
"248,153,30",8.47
"247,122,43",16.93
"255,0,238",7.14
"44,170,147",14.28
"183,24,242",9.32
"0,255,255",18.63
"70,145,13",7.59
"181,245,20",15.17
"255,0,0",6.63
"135,46,220",13.25
"248,153,30",5.67
"0,255,255",11.33
"0,0,255",15.68
"241,222,14",12.15
"0,255,0",24.29
"184,148,235",11.11
"26,21,162",22.21
"248,153,30",11.84
"255,0,255",12.01
"0,255,0",6.80
"255,0,0",13.6
"255,255,0",9.25
"0,0,255",4.63
"44,170,147",20.60
"247,242,129",17.51

0 Likes