;Export block coordinates and properties, even in AutoCAD LT (2024 and higher)
;(C)2024 ARKANCE CZ, www.cadforum.cz
;
;V1.1 - added dynamic blocks, optional scale and rotation angle (uncomment second line '***', comment the first)
;V1.2 - added optional extra atributes - e.g.: Color, Handle, IsPlanar, CastShadows, Annotative, Normal/Z ... (see dumpallproperties)
;V1.3 - added dynamic values and visibility states - e.g.: Visibility1, DynAngle1, Linear2 ...
;
;to list all internal properties of a block, enter: "(dumpallproperties (car (entsel)))"

(setq __BCextraproperties '( 
  ; "Color" "IsDynamicBlock" "IsPlanar" "Normal/Z" ;  include extra parameters like Normal/Z, IsPlanar, AttTag1, AttTag2, Visibility1, DynProp1
))

(if (not __BCprecision)(setq __BCprecision 6)) ; decimals
(if (not __BCdelimiter)
 (setq __BCdelimiter (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (","))) ; take Sys delimiter
)

(defun C:BlockCoords ( / e edata bname ebname ss ssl i f fn pt obj att atts cnt rot scl lay el datt)
  (defun rtd (a) (/ (* a 180.0) pi))

  (vl-load-com)
  (while (not e)
   (and
    (setq e (car (entsel "\nSelect sample block to export: ")))
    (setq edata (entget e))
    (if (/= (cdr (assoc 0 edata)) "INSERT")(progn (princ " this is not a block! ")(setq e nil)))
   )
  )
  (setq bname (cdr (assoc 2 edata))
		ebname (vla-get-Effectivename (setq obj (vlax-ename->vla-object e)))
		atts ""
  )
  (princ (strcat bname (if (= (ascii bname) 42) (strcat " (" ebname ")") ""))) ; "*" ?
  (princ "\nSelect blocks to export coordinates <all>")
  (setq ss (ssget (list (cons 0 "INSERT")(cons 2 (strcat ebname ",`*U*"))))  i 0  cnt 0)
  (if (not ss)(setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 2 (strcat ebname ",`*U*")))))) ; All?
  (if (and ss (> (setq ssl (sslength ss)) 0))(progn
   (princ (strcat "\nExporting " (itoa ssl) " block references..."))
   (setq f (open (setq fn (strcat (getvar "WORKINGFOLDER") "\\" (getvar "DWGNAME") ".csv")) "w"))
   (if f (progn
    (foreach att (vlax-invoke obj 'GetAttributes)(setq atts (strcat atts __BCdelimiter "\"" (vlax-get att 'TagString) "\"")))
    (foreach att __BCextraproperties (setq atts (strcat atts __BCdelimiter "\"" att "\"")))
    (princ (strcat "X" __BCdelimiter "Y" __BCdelimiter "Z"  __BCdelimiter "Scale" __BCdelimiter "Angle" __BCdelimiter "Layer" atts) f) ; CSV Header - full
;    (princ (strcat "X" __BCdelimiter "Y" __BCdelimiter "Z" atts) f) ; CSV Header - no scale/rot/layer
    (while (< i ssl) ; all selected
      (setq e (ssname ss i)
			edata (entget e)
			pt (cdr (assoc 10 edata))
			scl (cdr (assoc 41 edata))
			rot (cdr (assoc 50 edata))
			lay (cdr (assoc 8 edata))
			obj (vlax-ename->vla-object e)
			atts ""
      )

      (if (= (strcase ebname) (strcase (vla-get-effectivename obj)))(progn
       (foreach att (vlax-invoke obj 'GetAttributes) ; all attribute values
        (setq atts (strcat atts __BCdelimiter "\"" (vlax-get att 'TextString) "\""))
       )
       (setq datt (mapcar '(lambda ( x ) (cons (vla-get-propertyname x) (vlax-get x 'value)))
                    (vlax-invoke obj 'getdynamicblockproperties)
                  )) ; e.g. (("Visibility1" . "Full") ("Angle1" . 1.3) ("Origin" 0.0 -5.0))
       (setq el (mapcar '(lambda (p / x) ; create list of extra values
        (if (assoc p datt) (setq x (cdr (assoc p datt))) ; dyn? else:
         (if (vl-catch-all-error-p (setq x (vl-catch-all-apply 'getpropertyvalue (list e p)))) "" x)
        )
        ) __BCextraproperties) ; mapcar
       )

       (foreach att el (setq atts (strcat atts __BCdelimiter (vl-prin1-to-string att)))) ; all extra values

       (princ (strcat "\n" (rtos (car pt) 2 __BCprecision) __BCdelimiter (rtos (cadr pt) 2 __BCprecision) __BCdelimiter (rtos (caddr pt) 2 __BCprecision)
                      __BCdelimiter (rtos scl 2 __BCprecision) __BCdelimiter (rtos (rtd rot) 2 __BCprecision) __BCdelimiter "\"" lay "\"" ; comment this if no scale/rot/layer
                      atts) ; attributes + extra parameters
               f)
       (setq cnt (1+ cnt))
      ));if
      (setq i (1+ i))
    );while
    (close f)
    (princ (strcat "\n" (itoa cnt) " coordinates and values of " ebname " exported to " fn))
   );else
    (princ "\nCSV file cannot be created!")
   );if f
  ));if ss
 (princ)
)

(princ "\nLoaded (V1.3). Type BLOCKCOORDS to export block coordinates.")
(princ)