Jump to content

Lines Colors to CSV

asdfgh

By asdfgh
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

asdfgh Contributor

asdfgh

Posted
Posted

Hello everyone, I have a lisp which gets the coordinates of a line and also gets its color. The problem is it gets the color in index not the true color, so for example for the blue color it gets "5"

image.png.34a560613479660cab245f40bb8f7ffe.png

image.png.cd12635749f200a7231f3a22485976f8.png

 

instead of "0,0,255" thats what i want

 

image.png.4c18698c160426fb6685633d56f41360.png

The lisp is attached. Can anyone help with that ?

Thank you

LLC.lsp

Link to comment
Share on other sites
exceed Proficient

exceed

Posted
Posted (edited)
2 hours ago, asdfgh said:

sorry i am new to autolisp, where should i put the codes in the link you shared ? 

(defun c:LLC ( / js dxf_cod mod_sel n lremov str_sep oldim ename X1 Y1 X2 Y2 col tmp f_open)
  (princ "\nSelect a model object to make filter: ")
  (while
    (null
      (setq js
        (ssget "_+.:E:S"
          (list
            '(0 . "LINE")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
          )
        )
      )
    )
    (princ "\nIsn't a Line!")
  )
  (vl-load-com)
  (setq dxf_cod (entget (ssname js 0)))
  (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 48))) (setq lremov (cons (car n) lremov))))
    (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
  )
  (initget "Single All Manual")
  (if (eq (setq mod_sel (getkword "\nApply filter to ? [Single/All/Manual]<Manual>: ")) "Single")
    (setq n -1)
    (if (eq mod_sel "All")
        (setq js (ssget "_X" dxf_cod) n -1)
        (setq js (ssget dxf_cod) n -1)
    )
  )
  (setq
    tmp (vl-filename-mktemp "tmp.csv")
    f_open (open tmp "w")
    str_sep ";"
    oldim (getvar "dimzin")
  )
  (setvar "dimzin" 0)
  (write-line (strcat "X1" str_sep "Y1" str_sep "X2" str_sep "Y2" str_sep "Color") f_open)
  (repeat (sslength js)
    (setq
      ename (ssname js (setq n (1+ n)))
      dxf_cod (entget ename)
      X1 (cadr (assoc 10 dxf_cod))
      Y1 (caddr (assoc 10 dxf_cod))
      X2 (cadr (assoc 11 dxf_cod))
      Y2 (caddr (assoc 11 dxf_cod))
    )
    (write-line
      (strcat
        (rtos X1 2 3)
        str_sep
        (rtos Y1 2 3)
        str_sep
        (rtos X2 2 3)
        str_sep
        (rtos Y2 2 3)
        str_sep
        (if (assoc 420 dxf_cod)
          (progn
            (setq col (LM:True->RGB (cdr (assoc 420 dxf_cod))))
            (strcat (itoa (car col)) "," (itoa (cadr col)) "," (itoa (caddr col)))
          )
          (progn
            (cond
              ((= (assoc 62 dxf_cod) 256)
                "by layer"
              )
              ((= (assoc 62 dxf_cod) 0)
                "by block"
              )
              (t
                (setq col (LM:ACI->RGB (cdr (assoc 62 dxf_cod))))
                (strcat (itoa (car col)) "," (itoa (cadr col)) "," (itoa (caddr col)))
              )
            ) ;end of cond
          ) ;end of progn
        ) ;end of if
      )
      f_open
    )
  )
  (close f_open)
  (startapp "notepad" tmp)
  (setvar "dimzin" oldim)
  (prin1)
)

;; True -> RGB  -  Lee Mac
;; Args: c - [int] True Colour

(defun LM:True->RGB ( c )
  (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24))
)

;; ACI -> RGB  -  Lee Mac
;; Args: c - [int] ACI (AutoCAD Colour Index) Colour (1<=c<=255)

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

;; Application Object  -  Lee Mac
;; Returns the VLA Application Object

(defun LM:acapp nil
    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
    (LM:acapp)
)

 

like this, this code is not tested

Edited by exceed
  • Like 1
Link to comment
Share on other sites
asdfgh Contributor

asdfgh

Posted
  • Author
Posted (edited)

thank you for your reply, it works well some times, but other times is does not work and goves this error

"Error: ActiveX Server returned an error: Parameter not optional; error: bad argument type: fixnump: nil"

i will attach a file that things are not working with me.

i guess this problem happens with the line color is not index, so can there be something general that can consider all color types and change all to true colors ?

 

Can that be fixed ?Drawing2.dwg

Edited by asdfgh
Link to comment
Share on other sites
exceed Proficient

exceed

Posted
Posted (edited)
11 hours ago, asdfgh said:

thank you for your reply, it works well some times, but other times is does not work and goves this error

"Error: ActiveX Server returned an error: Parameter not optional; error: bad argument type: fixnump: nil"

i will attach a file that things are not working with me.

i guess this problem happens with the line color is not index, so can there be something general that can consider all color types and change all to true colors ?

 

Can that be fixed ?Drawing2.dwg

 

try this 

(defun c:LLC ( / js dxf_cod mod_sel n lremov str_sep oldim ename X1 Y1 X2 Y2 col tmp f_open thatlayer layercol thatlayertruecolor layerred layergreen layerblue )
  (princ "\nSelect a model object to make filter: ")
  (while
    (null
      (setq js
        (ssget "_+.:E:S"
          (list
            '(0 . "LINE")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
          )
        )
      )
    )
    (princ "\nIsn't a Line!")
  )
  (vl-load-com)
  (setq dxf_cod (entget (ssname js 0)))
  (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 48))) (setq lremov (cons (car n) lremov))))
    (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
  )
  (initget "Single All Manual")
  (if (eq (setq mod_sel (getkword "\nApply filter to ? [Single/All/Manual]<Manual>: ")) "Single")
    (setq n -1)
    (if (eq mod_sel "All")
        (setq js (ssget "_X" dxf_cod) n -1)
        (setq js (ssget dxf_cod) n -1)
    )
  )
  (setq
    tmp (vl-filename-mktemp "tmp.csv")
    f_open (open tmp "w")
    str_sep ";"
    oldim (getvar "dimzin")
  )
  (setvar "dimzin" 0)
  (write-line (strcat "X1" str_sep "Y1" str_sep "X2" str_sep "Y2" str_sep "Color") f_open)
  (repeat (sslength js)
    (setq
      ename (ssname js (setq n (1+ n)))
      dxf_cod (entget ename)
      X1 (cadr (assoc 10 dxf_cod))
      Y1 (caddr (assoc 10 dxf_cod))
      X2 (cadr (assoc 11 dxf_cod))
      Y2 (caddr (assoc 11 dxf_cod))
    )
    (write-line
      (strcat
        (rtos X1 2 3)
        str_sep
        (rtos Y1 2 3)
        str_sep
        (rtos X2 2 3)
        str_sep
        (rtos Y2 2 3)
        str_sep
        (if (assoc 420 dxf_cod)
          (progn
            (setq col (LM:True->RGB (cdr (assoc 420 dxf_cod))))
            (strcat (itoa (car col)) "," (itoa (cadr col)) "," (itoa (caddr col)))
          )
          (progn
            (if (assoc 62 dxf_cod)
              (progn
                (cond 
                  ((= (cdr (assoc 62 dxf_cod)) 0) 
                    "by block"
                  )
                  ((and (> (cdr (assoc 62 dxf_cod)) 0) (< (cdr (assoc 62 dxf_cod)) 256))
                    (setq col (LM:ACI->RGB (cdr (assoc 62 dxf_cod))))
                    (strcat (itoa (car col)) "," (itoa (cadr col)) "," (itoa (caddr col)))
                  )
                )
              )
              (progn
                (setq col (vlax-get-property (vlax-ename->vla-object ename) 'color))                 
                (cond 
                  ((= col 256)
                    (setq thatlayer (vlax-get-property (vlax-ename->vla-object ename) 'layer))
                    (setq thatlayertruecolor (vlax-get-property (vla-Item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-Acad-Object))) thatlayer) 'truecolor))
                    (setq layerred (vlax-get-property thatlayertruecolor 'red))
                    (setq layergreen (vlax-get-property thatlayertruecolor 'green))
                    (setq layerblue (vlax-get-property thatlayertruecolor 'blue))
                    (setq layercol (list layerred layergreen layerblue))
                    (strcat "by layer ( " (itoa (car layercol)) "," (itoa (cadr layercol)) "," (itoa (caddr layercol)) " )")
                  )
                  ((= col 0)
                    "by block"
                  )
                );end of cond
              );end of progn
            ) ;end of if
          ) ;end of progn
        ) ;end of if
      )
      f_open
    )
  )
  (close f_open)
  (startapp "notepad" tmp)
  (setvar "dimzin" oldim)
  (prin1)
)

;; True -> RGB  -  Lee Mac
;; Args: c - [int] True Colour

(defun LM:True->RGB ( c )
  (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24))
)

;; ACI -> RGB  -  Lee Mac
;; Args: c - [int] ACI (AutoCAD Colour Index) Colour (1<=c<=255)

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


;; Application Object  -  Lee Mac
;; Returns the VLA Application Object

(defun LM:acapp nil
    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
    (LM:acapp)
)

 

fix, in case of 'If the color is by layer, and the color of the layer is true color'

 

 

 

 

below is old version 

(defun c:LLC ( / js dxf_cod mod_sel n lremov str_sep oldim ename X1 Y1 X2 Y2 col tmp f_open thatlayer layercol)
  (princ "\nSelect a model object to make filter: ")
  (while
    (null
      (setq js
        (ssget "_+.:E:S"
          (list
            '(0 . "LINE")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
          )
        )
      )
    )
    (princ "\nIsn't a Line!")
  )
  (vl-load-com)
  (setq dxf_cod (entget (ssname js 0)))
  (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 48))) (setq lremov (cons (car n) lremov))))
    (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
  )
  (initget "Single All Manual")
  (if (eq (setq mod_sel (getkword "\nApply filter to ? [Single/All/Manual]<Manual>: ")) "Single")
    (setq n -1)
    (if (eq mod_sel "All")
        (setq js (ssget "_X" dxf_cod) n -1)
        (setq js (ssget dxf_cod) n -1)
    )
  )
  (setq
    tmp (vl-filename-mktemp "tmp.csv")
    f_open (open tmp "w")
    str_sep ";"
    oldim (getvar "dimzin")
  )
  (setvar "dimzin" 0)
  (write-line (strcat "X1" str_sep "Y1" str_sep "X2" str_sep "Y2" str_sep "Color") f_open)
  (repeat (sslength js)
    (setq
      ename (ssname js (setq n (1+ n)))
      dxf_cod (entget ename)
      X1 (cadr (assoc 10 dxf_cod))
      Y1 (caddr (assoc 10 dxf_cod))
      X2 (cadr (assoc 11 dxf_cod))
      Y2 (caddr (assoc 11 dxf_cod))
    )
    (write-line
      (strcat
        (rtos X1 2 3)
        str_sep
        (rtos Y1 2 3)
        str_sep
        (rtos X2 2 3)
        str_sep
        (rtos Y2 2 3)
        str_sep
        (if (assoc 420 dxf_cod)
          (progn
            (setq col (LM:True->RGB (cdr (assoc 420 dxf_cod))))
            (strcat (itoa (car col)) "," (itoa (cadr col)) "," (itoa (caddr col)))
          )
          (progn
            (if (assoc 62 dxf_cod)
              (progn
                (cond 
                  ((= (cdr (assoc 62 dxf_cod)) 0) 
                    "by block"
                  )
                  ((and (> (cdr (assoc 62 dxf_cod)) 0) (< (cdr (assoc 62 dxf_cod)) 256))
                    (setq col (LM:ACI->RGB (cdr (assoc 62 dxf_cod))))
                    (strcat (itoa (car col)) "," (itoa (cadr col)) "," (itoa (caddr col)))
                  )
                )
              )
              (progn
                (setq col (vlax-get-property (vlax-ename->vla-object ename) 'color))                 
                (cond 
                  ((= col 256)
                    "by layer"
                    (setq thatlayer (tblsearch "layer" (vlax-get-property (vlax-ename->vla-object ename) 'layer)))
                    (if (assoc 420 thatlayer)
                      (progn
                        (setq layercol (LM:True->RGB (cdr (assoc 420 thatlayer))))
                        (strcat "by layer ( " (itoa (car layercol)) "," (itoa (cadr layercol)) "," (itoa (caddr layercol)) " )")
                      )
                      (progn
                        (if (assoc 62 thatlayer)
                          (progn
                            (cond 
                              ((= (cdr (assoc 62 thatlayer)) 0) 
                                "by block"
                              )
                              ((and (> (cdr (assoc 62 thatlayer)) 0) (< (cdr (assoc 62 thatlayer)) 256))
                                (setq layercol (LM:ACI->RGB (cdr (assoc 62 thatlayer))))
                                (strcat "by layer ( " (itoa (car layercol)) "," (itoa (cadr layercol)) "," (itoa (caddr layercol)) " )")
                              )
                            );end of cond
                          );end of progn
                          (progn
                            "N/A"
                          )
                        );end of if
                      );end of progn
                    );end of if
                  )
                  ((= col 0)
                    "by block"
                  )
                );end of cond
              );end of progn
            ) ;end of if
          ) ;end of progn
        ) ;end of if
      )
      f_open
    )
  )
  (close f_open)
  (startapp "notepad" tmp)
  (setvar "dimzin" oldim)
  (prin1)
)

;; True -> RGB  -  Lee Mac
;; Args: c - [int] True Colour

(defun LM:True->RGB ( c )
  (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24))
)

;; ACI -> RGB  -  Lee Mac
;; Args: c - [int] ACI (AutoCAD Colour Index) Colour (1<=c<=255)

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

;; Application Object  -  Lee Mac
;; Returns the VLA Application Object

(defun LM:acapp nil
    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
    (LM:acapp)
)

 

Edited by exceed
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...