Block attribute extraction

[Gorra]

Hello,

I am trying to extract attributes from all copies of a specific block to csv. I found a very promising LISP by @ronjonp in a related thread, but it has a user selection via polyline, where I just always want the same block without the user needing select them (there's hundreds of copies per drawing). 

I hope I just need to know where to change the selection method. The LISP is:

(defun c:foo (/ _writefile a e p r s z)
  ;; RJP » 2020-07-14
  (defun _writefile (fn lst / f)
    (cond ((and (eq 'str (type fn)) (setq f (open fn "w")))
	   (foreach x lst
	     (if (= 'list (type x))
	       (write-line
		 (apply 'strcat (mapcar '(lambda (z) (strcat (vl-princ-to-string z) ",")) x))
		 f
	       )
	       (vl-princ-to-string x)
	     )
	   )
	   (close f)
	   fn
	  )
    )
  )
  (cond	((and (setq e (car (entsel "\Pick fence for selection: ")))
	      (setq p (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget e)))
	      (setq s (ssget "_F" (mapcar 'cdr p) '((0 . "INSERT") (66 . 1))))
	 )
	 (sssetfirst nil s)
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq a (vlax-invoke (vlax-ename->vla-object e) 'getattributes))
	   (setq r (cons (append (cdr (assoc 10 (entget e))) (mapcar 'vla-get-textstring a)) r))
	 )
	 (princ	(_writefile
		  (strcat (getvar 'dwgprefix) "BlockStuff.csv")
		  (append '((x y z attvals)) (reverse r))
		)
	 )
	)
  )
  (princ)
)
(vl-load-com)

 Any help would be appreciated

Thanks,

Gorra

[ronjonp]

@Gorra 

;; Replace this
(and (setq e (car (entsel "\Pick fence for selection: ")))
     (setq p (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget e)))
     (setq s (ssget "_F" (mapcar 'cdr p) '((0 . "INSERT") (66 . 1))))
)
;; With this
(setq s (ssget "_X" '((0 . "INSERT") (66 . 1) (2 . "YOURBLOCKNAME"))))

[Gorra]

Thank you, that's what I was looking for

[ronjonp]

---

@Gorra wrote:

Thank you, that's what I was looking for

---

You're welcome 👍

[Gorra]

When I load the lisp, CAD says it loaded successfully but when I type it I get an 'unknown command' error. I checked the lisp in the built-in lisp editor, it gives a warning "local variable used as function: _writefile"

I checked other lisp functions and they are loading ok.

[ronjonp · Accepted solution]

@Gorra Weird .. this loads fine for me:

(defun c:foo (/ _writefile a e p r s z)
  ;; RJP » 2020-07-14
  (defun _writefile (fn lst / f)
    (cond ((and (eq 'str (type fn)) (setq f (open fn "w")))
	   (foreach x lst
	     (if (= 'list (type x))
	       (write-line
		 (apply 'strcat (mapcar '(lambda (z) (strcat (vl-princ-to-string z) ",")) x))
		 f
	       )
	       (vl-princ-to-string x)
	     )
	   )
	   (close f)
	   fn
	  )
    )
  )
  (cond	((setq s (ssget "_X" '((0 . "INSERT") (66 . 1) (2 . "YOURBLOCKNAME"))))
	 (sssetfirst nil s)
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq a (vlax-invoke (vlax-ename->vla-object e) 'getattributes))
	   (setq r (cons (append (cdr (assoc 10 (entget e))) (mapcar 'vla-get-textstring a)) r))
	 )
	 (princ	(_writefile
		  (strcat (getvar 'dwgprefix) "BlockStuff.csv")
		  (append '((x y z attvals)) (reverse r))
		)
	 )
	)
  )
  (princ)
)
(vl-load-com)

[Gorra]

Ok, I have finally gotten it to load by removing the _writefile from the list of variables, which my copy of Map3D didn't like (It loaded unmodified with another workstation, just not mine).

Instead of extracting attributes of all copies of a block to a csv, it is inserting a new copy of the target block. Is the insertion required for how this script works?

Thanks,

Gorra

[ronjonp]

@Gorra Are you loading the code I provided? There is nothing in it that would insert blocks?

[Gorra]

Ah. I wasn't matching the name of the LISP to the defun. Once I typed foo and had it work I clued in.

All working now.

To get the attribute names to extract for the top row of the csv, do I just add them to the list in the x y z ATTVALS?

Thanks

[ronjonp]

---

@Gorra wrote:

...

To get the attribute names to extract for the top row of the csv, do I just add them to the list in the x y z ATTVALS?

Thanks

---

How would you take care of headers of differing blocks? If all your blocks are the same this is doable.

[Gorra]

Yes, they're always the same block. They have 13 attributes, but don't need coordinates. If I put them into the line :

(append '((NAPNUMBER VACANT PREMISETYPE STREETTYPE STREETNAME NAPID ADDRESSID HOUSENUMBER F R B RSV 00_ID)) (reverse r))

would I need to change anything else? The attributes are all extracting currently, they just don't have headers.

Gorra

[ronjonp]

Give this version a try .. it creates the header using the tagstring values.

(defun c:foo (/ a e h p r s z)
  ;; RJP » 2023-06-06
  (defun _writefile (fn lst / f)
    (cond ((and (eq 'str (type fn)) (setq f (open fn "w")))
	   (foreach x lst
	     (if (= 'list (type x))
	       (write-line
		 (apply 'strcat (mapcar '(lambda (z) (strcat (vl-princ-to-string z) ",")) x))
		 f
	       )
	       (vl-princ-to-string x)
	     )
	   )
	   (close f)
	   fn
	  )
    )
  )
  (cond
    ((setq s (ssget "_X" '((0 . "INSERT") (66 . 1) (2 . "*"))))
     (sssetfirst nil s)
     (foreach e	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       ;; Get the attributes
       (setq a (vlax-invoke (vlax-ename->vla-object e) 'getattributes))
       ;; Compile a list of attribute values
       (setq r (cons (append (mapcar 'vla-get-textstring a)) r))
       ;; Create header of tagstring values
       (or h (setq h (mapcar '(lambda (x) (vla-get-tagstring x)) a)))
     )
     ;; Write the file
     (princ (_writefile (strcat (getvar 'dwgprefix) "BlockStuff.csv") (append (list h) (reverse r)))
     )
    )
  )
  (princ)
)
(vl-load-com)

[Gorra]

Thanks @ronjonp, both versions run quite well. It turns out I do need the coordinates after all, so the first one is what I'm working with. (and thanks for adding comments, I'm starting to grasp how it all works)

The northing coordinate is in Canada, so is in the 5.5million meters range. It is coming into the csv rounded to the nearest 10, whereas I need it to 3 decimals. I've been digging through the command list & group codes for hours and can't find anything that specifies precision. Is there a switch/argument/code I can tuck in behind the attribute headers? No need recode, I'm trying to see if I can understand this well enough to reverse the process after the csv gets updated. 

Thanks

[Gorra]

@ronjonp Hi, I'm still having some trouble with the precision problem, with the easting coming in rounded off to the nearest 10m. I've put the coordinates into a list called Lctn after doing an rtos with the right precision, but I can't figure out where in the cons line it should go. I've tried between the cons and append commands, and after the append command, with and without apostrophes. I just get bad argument type or too many arguments. Which doesn't make sense to me as the append is supposed to string lists together. I'm assuming I'm missing something obvious.

(defun c:MPTBLK (/ a e p r SelSet z SnapHold Northing Nrthng Easting Estng Lctn) ;; this lisp extracts the position                                                                                                                                                        ;; and data fields of all MPT blocks in the drawing.

  ;; RJP » 2020-07-14

  (vl-load-com)

  (command _attdia 0) ; turnoff attdia

  (setq SnapHold (getvar 'osmode)) ; records current snap settings

  (setvar 'osmode 0) ; turns off snaps

  (setvar 'luprec 😎 ; sets significant digits to maximum

  (defun _writefile (FlNm lst / f) 

    (cond ((and (eq 'str (type FlNm)) (setq f (open FnNm "w"))) ; While the file name is a string and the

                                                                                                              ; file is open for writing then: 

   (foreach x lst

     (if (= 'list (type x)) ; if x is a list then: 

       (write-line

(apply 'strcat (mapcar '(lambda (z) (strcat (vl-princ-to-string z) ",")) x))

FlNm

       ) ; end true

       (vl-princ-to-string x) ; end false

     )

   ) ; end foreach

   (close f) ; close file

   fn 

) ; end "and"

    ) ; end cond

  )

  (cond ((setq SelSet (ssget "_X" '((0 . "INSERT") (66 . 1) (2 . "MPT")))) ; Selet all blocks named MPT

(sssetfirst nil SelSet)

(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex SelSet)))

   (setq a (vlax-invoke (vlax-ename->vla-object e) 'getattributes))

   (setq Northing (getpropertyvalue e "Position/X"))

   (setq Easting (getpropertyvalue e "Position/Y"))

   (setq Nrthng (rtos Northing 2 3))

   (setq Estng (rtos Easting 2 3))

   (setq Lctn (list Nrthng Estng))

   (setq r (cons (append (cdr (assoc 10 (entget e))) (mapcar 'vla-get-textstring a)) r))

) ; end foreach

(princ (_writefile

  (strcat (getvar 'dwgprefix) "MPTBLK.csv") ; passes to _writefile function as argument "FlNm"

  (append '((NORTH EAST z NUMPORT TAILLENGTH NAPNUMBER LIVESTART LIVEEND DEADSTART DEADEND LOCATION POLEID SPLICEID ADDRESS NAPID SPLICEORDER ADDRESSID )) (reverse r)) 

  ; passes to _writefile as argument "lst"

)

)

)

  )

  (setvar 'osmode SnapHold)

  (princ)

)

[ronjonp]

@Gorra 

Try upping your precision from 3 to 16 for RTOS like so:

	   (setq nrthng (rtos northing 2 16))
	   (setq estng (rtos easting 2 16))

Also changing the LUPREC variable does not help with this problem. LUPREC changes the precision you see in the properties palette.

[Gorra]

The numbers are coming out ok for precision with the 2-3, it's just a matter of getting the values into the list so they're included in the writefile. I thought this should work:

(setq r (cons (append 'Lctn (cdr (assoc 10 (entget e))) (mapcar 'vla-get-textstring a)) r))

but returns a bad argument

or this:

(setq r (cons (append (setq Lctn (list Nrthng Estng)) (cdr (assoc 10 (entget e))) (mapcar 'vla-get-textstring a)) r))

but still returns bad argument.

Sorry, the error was coming from a typo elsewhere in the code. There's a different problem but I'll make a new thread for it.

[ronjonp · Accepted solution]

@Gorra Try this .. although not sure why you're not using the code I provided above?

(setq r (cons (append Lctn (mapcar 'vla-get-textstring a)) r))

[Gorra]

I didn't see the reply in time. That works just right. I'll see if I can cancel a post now.

Thank you