Leaderboard

(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

Just an extra to what Mhupp provided ignoring the number v's string you must check more carefully for typo's ("BLOCK2" "LAYER2" "500" ""500 "1") 2 mistakes a double "" and a missing "

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.!!!

This will get you started. do what you want. Scales from the insertion point of the block. (defun c:BLKSCALE (/ blklst SS obj ed) (setq blklst '(("BLOCK1" "LAYER1" 250 250) ("BLOCK2" "LAYER2" 500 500) ("BLOCK3" "LAYER3" 150 150) ("BLOCK4" "LAYER4" 100 100)) ) (foreach ent blklst (setq blkname (car ent) ent (cdr ent)) (if (setq SS (ssget "_X" (list '(0 . "INSERT") (cons 2 blkname)))) (foreach blk (mapcar 'cadr (ssnamex SS)) (setq ed (entget blk) ed (subst (cons 8 (car ent)) (assoc 8 ed) ed) ed (subst (cons 41 (cadr ent))(assoc 41 ed) ed) ed (subst (cons 42 (caddr ent)) (assoc 42 ed) ed) ed (subst (cons 43 1) (assoc 43 ed) ed) ;This was always one so removed from list ) (entmod ed) ) ) ) (princ) )