Extracting data to excel from selected objects on different layers

[exceed]

14 hours ago, Hsanon said:

how do i output "open" or "closed" for ploylines (its showing -1 and 0 )

 

 

(defun C:SSAEXT4 (/ output Mainoutput SS ent P1 P2 P3 P4 P5 P6 P7 P8 P9 P10) ;best to name variables
  (vl-load-com)
  (if (setq SS (ssget '((0 . "LWPOLYLINE,LINE,POINT"))))
    (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq ent (vlax-ename->vla-object obj)
            P1 (vla-get-Objectname ent)
      )
      (cond
        ((eq "AcDbPoint" P1)
             (setq P2 (vlax-get ent 'layer)
                   P3 (itoa(vlax-get ent 'color))
                   P10 (rtos(caddr (vlax-get ent 'Coordinates))2)
                   output (list P1 P2 P3 "-" "-" "-" "-" "-" "-" P10)
             )  ;setq
        )       ;eq
        ((eq "AcDbLine" P1)
             (setq P2 (vlax-get ent 'layer)
                   P3 (itoa(vlax-get ent 'color))
                   P4 (rtos(vlax-get ent 'length)2)
                   P5 (vlax-get ent 'linetype)
                   P6 (vlax-get ent 'Lineweight)
                   P7 (rtos(vlax-get ent 'thickness)2)
                   P8 "0"
                   P9 "VOID"
                   P10 (rtos(caddr (vlax-get ent 'Startpoint))2)  ;assumes flat line
             )  ; setq
             (cond ((= P6 -1) (setq P6 "ByLayer"))
                     ((= P6 -2) (setq P6 "ByBlock"))
                     ((= P6 -3) (setq P6 "Default"))
                     ((< P6 10) (setq P6 (strcat "0.0" (vl-princ-to-string P6) "mm") ))
                     ((< P6 100) (setq P6 (strcat "0." (vl-princ-to-string P6) "mm") ))
                     ((>= P6 100) (setq P6 (strcat (substr (vl-princ-to-string P6) 1 1) "." (substr (vl-princ-to-string P6) 2 2) "mm") )) 
             )
             (setq output (list P1 P2 P3 P4 P5 P6 P7 P8 P9 P10))

        )       ; eq
        ((eq "AcDbPolyline" P1)
             (setq P2 (vlax-get ent 'layer)
                   P3 (itoa(vlax-get ent 'color))
                   P4 (rtos(vlax-get ent 'length)2)
                   P5 (vlax-get ent 'linetype)
                   P6 (vlax-get ent 'Lineweight)
                   P7 (rtos(vlax-get ent 'thickness)2)
                   P8 (rtos(/ (vlax-get ent 'area) 1000000)2)
                   P9 (vlax-get ent 'closed)
                   P10 (rtos(vlax-get ent 'Elevation)2)
             )  ;setq
             (cond ((= P9 -1) (setq P9 "Closed"))
                     ((= P9 0) (setq P9 "Opened"))
             )
             (cond ((= P6 -1) (setq P6 "ByLayer"))
                     ((= P6 -2) (setq P6 "ByBlock"))
                     ((= P6 -3) (setq P6 "Default"))                    
                     ((< P6 10) (setq P6 (strcat "0.0" (vl-princ-to-string P6) "mm") ))
                     ((< P6 100) (setq P6 (strcat "0." (vl-princ-to-string P6) "mm") ))
                     ((>= P6 100) (setq P6 (strcat (substr (vl-princ-to-string P6) 1 1) "." (substr (vl-princ-to-string P6) 2 2) "mm") )) 
             )
             (setq output (list P1 P2 P3 P4 P5 P6 P7 P8 P9 P10))
        )       ; eq
      )         ; cond
      (setq Mainoutput (cons output Mainoutput))
    )
    (prompt "/nNothing Selected")
  )
  (if ss
    (progn
      (setq file (open (getfiled "Name output file" (getvar "DWGPREFIX") "CSV" 1) "w"))
      (write-line "Name,Layer,Color,Length-mm,Linetype,Lineweight,Thickness,Area-sqm,Closed,DeltaZ" file)  ;;writes the headers to the .CSV
      (foreach row Mainoutput
        (write-line (lst2str "," row) file)
      )
      (close file)
    )
  )
  (princ)
)
;;----------------------------------------------------------------------------;;
;; Function to convert list to string 
;; (lst2str "," lst)
(defun lst2str (dlim lst / rtn)
  (setq rtn (car lst) lst (cdr lst))
  (repeat (length lst)
    (setq rtn (strcat rtn dlim (car lst))
          lst (cdr lst)
    )
  )
  rtn
)

 

I just add small Duct Tapes fix to mhupp's code.

for polyline "opened" and "closed"

for line & polyline "lineweight" - ByLayer ByBlock Default and numbers.

 

I can't solve lineweight decimal point problem, I try to (rtos (/ P6 100) 2 2)

it deletes under decimal points values. MEASUREMENT system variable control that? I don't know.

so duct taping to that like this

 

((< P6 10) (setq P6 (strcat "0.0" (vl-princ-to-string P6) "mm") ))
((< P6 100) (setq P6 (strcat "0." (vl-princ-to-string P6) "mm") ))
((>= P6 100) (setq P6 (strcat (substr (vl-princ-to-string P6) 1 1) "." (substr (vl-princ-to-string P6) 2 2) "mm") )) 

 

it works anyway

Edited January 11, 2022 by exceed

[Hsanon]

Hey Exceed & Mhupp  !!!!

The routine is great and the duct tape works !!!! am going to test in "real life" conditions !!!!

May get back on the topic if some issue rises......

 

im finally starting to understand vlisp.... (a bit) 

all help much appreciated....all of you are inspirational.!!!

Edited January 11, 2022 by Hsanon