Hallo @pbejse !
Thaank You for answering in such a short notice and sorry for my blunt question!
I am trying to use Your Lisp ("Visibilityforyou2.0.LSP") for Dynamic Block with couple of Visibility Parameters(I do not mean States) - that Dynamic Block was made with another Lisp("visibility-add-eng_1_6"). You will find both in attachment.
Unfortenatly "Visibilityforyou2.0.LSP" extracts just one Visibility Parameter, and here I have more. That is my problem 🙂
I have just one Attribute ( Tag is "A"), Block Name is "B11"... I understand part of Lisp, but I lack "code-words" in order to modify it
(Defun _Selection (ss bn / e i dp Collection)
;;; pBe Feb 2020 ;;;
(repeat (setq i (sslength ss))
(setq e (vlax-ename->vla-object (ssname ss (setq i (1- i))))
h (Vla-get-handle e))
(if
(And
(eq (strcase (Vla-get-effectivename e)) bn)
(setq atv (mapcar '(lambda (at)
(list (Vla-get-tagstring at)
(if (setq fld (gc:FieldCode (vlax-vla-object->ename at))) fld
(Vla-get-textstring at)) at
)) (vlax-invoke e 'GetAttributes)))
(setq dp
(mapcar '(lambda (d)
(list (vlax-get d 'PropertyName)
(vlax-get d 'Value)
d
)
)
(vlax-invoke
e
'GetDynamicBlockProperties
)
)
)
(setq f (Cdr (Assoc "Visibility1" dp)))
)
(setq Collection (cons (list h f
(vl-remove-if-not '(lambda (v)
(member (Car v) taglist))
atv)) Collection))
)
)
Collection
)
(defun _FileOpen-p ( filename / f )
(if (setq f (open filename "a"))
(close f)
t
)
)
(defun _concatenate (lst m)
(setq f (if m '(cadr st) 'st))
(apply 'strcat (mapcar '(lambda (st)
(strcat "," (eval f))) lst ))
)
(defun c:VOTF ( / ppc opf externalFile a e dp VisColl) ;; Visibility Out To File
(setq taglist '("A"
)
)
;;; pBe Feb 2020 ;;;
(if
(and
(= (getvar 'Dwgtitled) 1)
(setq ppc (ssget '((0 . "INSERT")(66 . 1)(2 . "`*U*,B11"))))
(setq VisColl (_Selection ppc "B11"))
(setq externalFile (strcat (getvar 'dwgprefix)
(strcat (vl-filename-base (getvar 'dwgname)) ".csv"))
)
(setq csvStatus (not (_FileOpen-p externalFile)))
)
(progn
(setq opf (open externalFile "w"))
(write-line (strcat "Handle,Visibility" (_concatenate taglist nil))
opf)
(While (setq a (Car VisColl))
(Write-line (strcat (car a)","(caadr a)
( _concatenate (caddr a) t)
)
opf)
(setq VisColl (Cdr VisColl))
)
(close opf)
(if
(vl-catch-all-error-p
(vl-catch-all-apply 'LM:open (list externalFile))
)
(alert (strcat "Please close file\n" externalFile)))
(princ (strcat "\nFile name amd Location: " externalFile))
)
(princ (Strcat "\n<<<<<<<<<< "
(cond
( (null ppc) "No Valid selection" )
( (null VisColl) "No attributese found" )
( (null externalFile) "No CSV filename specified" )
( (null csvStatus) (strcat externalFile
"Opened for editing" )
)
)
" >>>>>>>>>>")
)
)
(princ)
)
(defun c:VIFF ( / ppc externalFile opf a data_lst d e f p VisColl) ;; Visibility In From File
;;; pBe Feb 2020 ;;;
(defun _DelTolst (str m / pos x lst lst2)
(if (setq pos (vl-string-position m str))
(cons (substr str 1 pos)
(_DelTolst (substr str (+ pos 2)) m)
)
(list str)
)
)
(if
(and
(= (getvar 'Dwgtitled) 1)
(setq ppc (ssget "_X" '((0 . "INSERT")(66 . 1)(2 . "`*U*,B11"))))
(setq VisColl (_Selection ppc "B11"))
(setq externalFile (strcat (getvar 'dwgprefix)(Vl-filename-base (getvar 'dwgname)) ".csv"))
(or
(findfile externalFile)
(setq externalFile (getfiled "Select Visibility Data" (getvar 'dwgprefix) "csv" 16))
)
)
(progn
(textscr)
(setq opf (open externalFile "r"))
(while (setq a (read-line opf))
(if (and
(setq p (vl-string-position 44 a))
(setq data_lst (_DelTolst a 44))
(setq f (assoc (Car data_lst) VisColl))
)
(progn
(vlax-put (cadadr f) 'Value (Cadr data_lst))
(foreach itm
(mapcar 'list taglist (cddr data_lst))
(if (setq d (assoc (car itm) (caddr f)))
(Vla-put-textstring (caddr d) (cadr itm))
)
)
(princ (strcat "\nHandle \"" (Car data_lst) "\" Visibiltiy \"" (Cadr data_lst) "\" is set and specific Attributes restored"))
)
)
)
(close opf)
)
)
(princ)
)
;;; Helper functions by others ;;;
;;; ;;;
;; Open - Lee Mac
;; A wrapper for the 'Open' method of the Shell Object
;; target - [int/str] File, folder or ShellSpecialFolderConstants enum
(defun LM:open ( target / rtn shl )
(if (and (or (= 'int (type target)) (setq target (findfile target)))
(setq shl (vla-getinterfaceobject (vlax-get-acad-object) "shell.application"))
)
(progn
(setq rtn (vl-catch-all-apply 'vlax-invoke (list shl 'open target)))
(vlax-release-object shl)
(if (vl-catch-all-error-p rtn)
(prompt (vl-catch-all-error-message rtn))
t
)
)
)
)
;; gc:FieldCode (gile)
;; Returns the string value of a text mtext or attribute with field code
;;
;; Argument : the entity name (ENAME)
(defun gc:FieldCode (ent / foo elst xdict dict field str)
;;--------------------------------------------------------;;
(defun foo (field str / pos fldID objID)
(setq pos 0)
(if (setq pos (vl-string-search "\\_FldIdx " str pos))
(while (setq pos (vl-string-search "\\_FldIdx " str pos))
(setq fldId (entget (cdr (assoc 360 field)))
field (vl-remove (assoc 360 field) field)
str (strcat
(substr str 1 pos)
(if (setq objID (cdr (assoc 331 fldId)))
(vl-string-subst
(strcat "ObjId " (itoa (gc:EnameToObjectId objID)))
"ObjIdx"
(cdr (assoc 2 fldId))
)
(foo fldId (cdr (assoc 2 fldId)))
)
(substr str (1+ (vl-string-search ">%" str pos)))
)
)
)
str
)
)
;;--------------------------------------------------------;;
(setq elst (entget ent))
(if (and
(member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT"))
(setq xdict (cdr (assoc 360 elst)))
(setq dict (dictsearch xdict "ACAD_FIELD"))
(setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
)
(setq str (foo field (cdr (assoc 2 field))))
)
)
;; gc:EnameToObjectId (gile)
;; Returns the ObjectId from an ename
;;
;; Argument : an ename
(defun gc:EnameToObjectId (ename)
((lambda (str)
(hex2dec
(substr (vl-string-right-trim ">" str) (+ 3 (vl-string-search ":" str)))
)
)
(vl-princ-to-string ename)
)
)
;;============================================================;;
;; hex2dec (gile)
;; Converts an hexadecimal (string) to a decimal (int)
;;
;; Argument : a string figuring an hexadecimal
(defun hex2dec (s / r l n)
(setq r 0 l (vl-string->list (strcase s)))
(while (setq n (car l))
(setq l (cdr l)
r (+ (* r 16) (- n (if (<= n 57) 48 55)))
)
)
)
(prompt
(strcat
"\n::---------------------------------------------------------::"
"\n:: VOTF to Write to file | VIFF for READ from file ::"
"\n::---------------------------------------------------------::"
)
)
(princ)
