Загрузка данных
;;; BR_VIS_MINI.lsp
;;; Standalone mini-LISP for writing dynamic block visibility state
;;; into hidden attributes: "Видимость" or "Видимость1", "Видимость2", ...
;;;
;;; Load with APPLOAD, then run BRV-HELP.
;;;
;;; HELP
;;; ----
;;; Purpose:
;;; BR_VIS_MINI writes the current visibility state of a dynamic block
;;; into hidden attributes. The attributes are invisible to the user, but
;;; remain available for data extraction.
;;;
;;; Main commands:
;;; BRV-HELP
;;; Show this help in the AutoCAD command line.
;;; BRV-INSTALL
;;; Pick a dynamic block reference, add hidden visibility attributes,
;;; write current values, embed this mini-LISP into the selected insert
;;; carrier, and attach reactors for the current drawing session.
;;; BRV-SYNC
;;; Pick one installed insert and rewrite its visibility attributes.
;;; BRV-SYNC-ALL
;;; Rewrite visibility attributes for all installed inserts in the DWG.
;;; BRV-REACTORS
;;; Reattach object reactors after opening a drawing or restoring code.
;;; BRV-EMBED
;;; Embed the current BR_VIS_MINI.lsp source into the selected insert.
;;; BRV-RESTORE
;;; Restore embedded mini-LISP from a selected insert to
;;; %APPDATA%\BR_VIS_MINI\BR_VIS_MINI.lsp and load it.
;;;
;;; Attribute rules:
;;; - If there are no visibility dynamic properties, no attributes are made.
;;; - If there is one visibility property, tag "Видимость" is used.
;;; - If there are several visibility properties, tags "Видимость1",
;;; "Видимость2", ... are used.
;;; - Attribute value is rewritten when the visibility state changes.
;;; - Attribute definitions are invisible + preset.
;;;
;;; Detection rule:
;;; A dynamic property is treated as visibility when it has AllowedValues
;;; and its name contains "Visibility" or "Видим".
;;;
;;; Transfer rule:
;;; A configured block carries hidden ATTDEF/ATTRIB data, an xData marker,
;;; and embedded mini-LISP text in the selected insert extension dictionary.
;;; AutoCAD security should not auto-run arbitrary LISP from a block, so on
;;; another machine load BR_VIS_MINI.lsp once through APPLOAD, or restore it
;;; with BRV-RESTORE when a bootstrap is already loaded. Then run
;;; BRV-REACTORS or BRV-SYNC-ALL.
(vl-load-com)
(setq brv:*version* "0.1.11")
(setq brv:*appid* "BR_VIS_MINI")
(setq brv:*dict-key-info* "BRV_INFO")
(setq brv:*dict-key-code-prefix* "BRV_CODE_PART_")
(setq brv:*dict-key-code-count* "BRV_CODE_PART_COUNT")
(setq brv:*code-part-size* 240)
(setq brv:*reactors* nil)
(setq brv:*syncing* nil)
(setq brv:*install-dir* "BR_VIS_MINI")
(setq brv:*source-path* nil)
(defun brv:str (value)
(cond
((null value) "")
((= (type value) 'STR) value)
((= (type value) 'INT) (itoa value))
((= (type value) 'REAL) (rtos value 2 8))
(T (vl-princ-to-string value))
)
)
(defun brv:println (text)
(princ (strcat "\n" (brv:str text)))
)
(defun brv:norm (text)
(strcase (vl-string-trim " \t\r\n" (brv:str text)))
)
(defun brv:timestamp (/ raw)
(setq raw (vl-catch-all-apply 'menucmd (list "M=$(edtime,$(getvar,date),YYYY-MM-DDTHH:MM:SS)")))
(if (and (not (vl-catch-all-error-p raw)) (= (type raw) 'STR))
raw
(rtos (getvar "DATE") 2 8)
)
)
(defun brv:map-get (key pairs / hit)
(setq hit (assoc key pairs))
(if hit (cdr hit) nil)
)
(defun brv:map-put (pairs key value / out done item)
(setq out nil)
(setq done nil)
(foreach item pairs
(if (= (car item) key)
(progn
(setq out (cons (cons key (brv:str value)) out))
(setq done T)
)
(setq out (cons item out))
)
)
(if (not done)
(setq out (cons (cons key (brv:str value)) out))
)
(reverse out)
)
(defun brv:parse-kv-string (text / pos)
(setq pos (vl-string-search "=" (brv:str text)))
(if pos
(cons (substr text 1 pos) (substr text (+ pos 2)))
nil
)
)
(defun brv:join (items sep / result item)
(if items
(progn
(setq result (brv:str (car items)))
(foreach item (cdr items)
(setq result (strcat result sep (brv:str item)))
)
result
)
""
)
)
(defun brv:split (text sep / out pos next seplen)
(setq text (brv:str text))
(setq sep (brv:str sep))
(if (= sep "")
(list text)
(progn
(setq out nil)
(setq pos 0)
(setq seplen (strlen sep))
(while (setq next (vl-string-search sep text pos))
(setq out (cons (substr text (+ pos 1) (- next pos)) out))
(setq pos (+ next seplen))
)
(setq out (cons (substr text (+ pos 1)) out))
(reverse out)
)
)
)
(defun brv:variant->plain (value)
(cond
((= (type value) 'VARIANT)
(brv:variant->plain (vlax-variant-value value)))
((= (type value) 'SAFEARRAY)
(mapcar 'brv:variant->plain (vlax-safearray->list value)))
(T value)
)
)
(defun brv:point-variant (pt)
(vlax-3d-point pt)
)
(defun brv:ensure-regapp ()
(if (not (tblsearch "APPID" brv:*appid*))
(regapp brv:*appid*)
)
)
(defun brv:block-insert-p (ename)
(and ename (= (cdr (assoc 0 (entget ename))) "INSERT"))
)
(defun brv:pick-insert (prompt / picked ename)
(setq picked (entsel prompt))
(if picked
(progn
(setq ename (car picked))
(if (brv:block-insert-p ename)
ename
(progn
(brv:println "Select a block reference.")
nil
)
)
)
nil
)
)
(defun brv:vla-object (ename)
(vl-catch-all-apply 'vlax-ename->vla-object (list ename))
)
(defun brv:effective-name (ename / obj)
(setq obj (brv:vla-object ename))
(if (vl-catch-all-error-p obj)
(cdr (assoc 2 (entget ename)))
(if (vlax-property-available-p obj 'EffectiveName)
(if (and (vla-get-EffectiveName obj) (/= (vla-get-EffectiveName obj) ""))
(vla-get-EffectiveName obj)
(cdr (assoc 2 (entget ename)))
)
(cdr (assoc 2 (entget ename)))
)
)
)
(defun brv:block-def-object-by-name (name / btr doc blocks obj)
(setq doc (vl-catch-all-apply 'vla-get-ActiveDocument (list (vlax-get-acad-object))))
(if (not (vl-catch-all-error-p doc))
(progn
(setq blocks (vl-catch-all-apply 'vla-get-Blocks (list doc)))
(if (not (vl-catch-all-error-p blocks))
(progn
(setq obj (vl-catch-all-apply 'vla-Item (list blocks name)))
(if (and obj (not (vl-catch-all-error-p obj)))
obj
nil
)
)
)
)
)
(if obj
obj
(progn
(setq btr (tblobjname "BLOCK" name))
(if btr
(progn
(setq obj (vl-catch-all-apply 'vlax-ename->vla-object (list btr)))
(if (and obj (not (vl-catch-all-error-p obj))) obj nil)
)
nil
)
)
)
)
(defun brv:block-def-object (ename / obj)
(setq obj (brv:block-def-object-by-name (brv:effective-name ename)))
(if obj
obj
(brv:block-def-object-by-name (cdr (assoc 2 (entget ename))))
)
)
(defun brv:dynamic-props (ename / obj variant arr)
(if (not (brv:block-insert-p ename))
nil
(progn
(setq obj (brv:vla-object ename))
(if (vl-catch-all-error-p obj)
nil
(progn
(setq variant (vl-catch-all-apply 'vlax-invoke (list obj 'GetDynamicBlockProperties)))
(if (vl-catch-all-error-p variant)
nil
(progn
(setq arr (brv:variant->plain variant))
(if (= (type arr) 'LIST) arr nil)
)
)
)
)
)
)
)
(defun brv:prop-name (prop)
(brv:str (vlax-get prop 'PropertyName))
)
(defun brv:prop-value (prop)
(brv:variant->plain (vlax-get prop 'Value))
)
(defun brv:prop-allowed-values (prop / raw values)
(setq raw (vl-catch-all-apply 'vlax-get (list prop 'AllowedValues)))
(if (vl-catch-all-error-p raw)
nil
(progn
(setq values (brv:variant->plain raw))
(cond
((= (type values) 'LIST) values)
((null values) nil)
(T (list values))
)
)
)
)
(defun brv:visibility-name-p (name / norm)
(setq norm (brv:norm name))
(or
(wcmatch norm "*VISIBILITY*")
(wcmatch norm "*ВИДИМ*")
)
)
(defun brv:visibility-prop-p (prop)
(and
(brv:prop-allowed-values prop)
(brv:visibility-name-p (brv:prop-name prop))
)
)
(defun brv:visibility-props (ename / out prop)
(setq out nil)
(foreach prop (brv:dynamic-props ename)
(if (brv:visibility-prop-p prop)
(setq out (append out (list prop)))
)
)
out
)
(defun brv:visibility-values (ename / out prop)
(setq out nil)
(foreach prop (brv:visibility-props ename)
(setq out (append out (list (cons (brv:prop-name prop) (brv:str (brv:prop-value prop))))))
)
out
)
(defun brv:attr-tags-for-count (count / out idx)
(cond
((<= count 0) nil)
((= count 1) (list "Видимость"))
(T
(setq out nil)
(setq idx 1)
(while (<= idx count)
(setq out (append out (list (strcat "Видимость" (itoa idx)))))
(setq idx (1+ idx))
)
out
)
)
)
(defun brv:definition-attr-tags (blockObj / out item name)
(setq out nil)
(if blockObj
(vlax-for item blockObj
(if (= (brv:str (vla-get-ObjectName item)) "AcDbAttributeDefinition")
(progn
(setq name (brv:str (vla-get-TagString item)))
(if name (setq out (append out (list name))))
)
)
)
)
out
)
(defun brv:definition-has-attr-tag-p (blockObj tag)
(if blockObj
(member (brv:norm tag) (mapcar 'brv:norm (brv:definition-attr-tags blockObj)))
nil
)
)
(defun brv:add-hidden-attdef (blockObj tag / res)
(if (brv:definition-has-attr-tag-p blockObj tag)
nil
(progn
;; Mode 9 = invisible + preset. Height 1.0, insertion at block origin.
(setq res
(vl-catch-all-apply
'vla-AddAttribute
(list blockObj 1.0 9 tag (brv:point-variant '(0.0 0.0 0.0)) tag "")
)
)
(if (vl-catch-all-error-p res)
(progn
(brv:println (strcat "Cannot add hidden ATTDEF " tag ": " (vl-catch-all-error-message res)))
nil
)
T
)
)
)
)
(defun brv:ensure-hidden-attdefs (ename count / blockObj tags tag changed)
(setq blockObj (brv:block-def-object ename))
(if (not blockObj)
nil
(progn
(setq changed nil)
(setq tags (brv:attr-tags-for-count count))
(foreach tag tags
(if (brv:add-hidden-attdef blockObj tag)
(setq changed T)
)
)
(if changed
(brv:attsync-insert ename)
)
tags
)
)
)
(defun brv:attsync-insert (ename / oldcmd oldecho)
(setq oldcmd (getvar "CMDECHO"))
(setq oldecho (getvar "NOMUTT"))
(setvar "CMDECHO" 0)
(setvar "NOMUTT" 1)
(vl-catch-all-apply 'command-s (list "_.ATTSYNC" "_S" ename ""))
(setvar "NOMUTT" oldecho)
(setvar "CMDECHO" oldcmd)
(princ)
)
(defun brv:attsync-block (blockName / oldcmd oldecho)
(setq oldcmd (getvar "CMDECHO"))
(setq oldecho (getvar "NOMUTT"))
(setvar "CMDECHO" 0)
(setvar "NOMUTT" 1)
(vl-catch-all-apply 'command-s (list "_.ATTSYNC" "_N" blockName))
(setvar "NOMUTT" oldecho)
(setvar "CMDECHO" oldcmd)
(princ)
)
(defun brv:attributes (ename / obj raw arr)
(setq obj (brv:vla-object ename))
(if (vl-catch-all-error-p obj)
nil
(progn
(setq raw (vl-catch-all-apply 'vlax-invoke (list obj 'GetAttributes)))
(if (vl-catch-all-error-p raw)
nil
(progn
(setq arr (brv:variant->plain raw))
(if (= (type arr) 'LIST) arr nil)
)
)
)
)
)
(defun brv:set-attribute-value (ename tag value / att found)
(setq found nil)
(foreach att (brv:attributes ename)
(if (= (brv:norm (vla-get-TagString att)) (brv:norm tag))
(progn
(vl-catch-all-apply 'vla-put-Invisible (list att :vlax-true))
(vl-catch-all-apply 'vla-put-TextString (list att (brv:str value)))
(setq found T)
)
)
)
found
)
(defun brv:set-xdata (ename pairs / edata item out xitem)
(brv:ensure-regapp)
(setq edata (entget ename '("*")))
(setq out nil)
(foreach item edata
(if (and (= (car item) -3)
(= (brv:norm (caadr item)) (brv:norm brv:*appid*)))
nil
(setq out (cons item out))
)
)
(setq xitem
(list
-3
(append
(list brv:*appid*)
(mapcar '(lambda (kv) (cons 1000 (strcat (car kv) "=" (cdr kv)))) pairs)
)
)
)
(entmod (append (reverse out) (list xitem)))
(entupd ename)
)
(defun brv:get-xdata (ename / edata item app pair out parsed)
(setq edata (entget ename '("*")))
(setq out nil)
(foreach item edata
(if (and (= (car item) -3)
(setq app (cadr item))
(= (brv:norm (car app)) (brv:norm brv:*appid*)))
(foreach pair (cdr app)
(if (and (= (car pair) 1000)
(setq parsed (brv:parse-kv-string (cdr pair))))
(setq out (cons parsed out))
)
)
)
)
(reverse out)
)
(defun brv:mark-insert-installed (ename count)
(brv:set-xdata
ename
(list
(cons "MODULE" "VIS_ATTR")
(cons "VERSION" brv:*version*)
(cons "BLOCKNAME" (brv:effective-name ename))
(cons "ATTR_COUNT" (itoa count))
(cons "UPDATED" (brv:timestamp))
)
)
)
(defun brv:insert-installed-p (ename)
(= (brv:map-get "MODULE" (brv:get-xdata ename)) "VIS_ATTR")
)
(defun brv:sync-insert (ename / props count tags values idx tag value)
(if (and (not brv:*syncing*) (brv:block-insert-p ename))
(progn
(setq brv:*syncing* T)
(setq props (brv:visibility-props ename))
(setq count (length props))
(if (> count 0)
(progn
(setq tags (brv:ensure-hidden-attdefs ename count))
(setq values (mapcar '(lambda (p) (brv:str (brv:prop-value p))) props))
(setq idx 0)
(foreach tag tags
(setq value (nth idx values))
(if (not (brv:set-attribute-value ename tag value))
(progn
(brv:attsync-insert ename)
(brv:set-attribute-value ename tag value)
)
)
(setq idx (1+ idx))
)
(brv:mark-insert-installed ename count)
)
)
(setq brv:*syncing* nil)
)
)
(princ)
)
(defun brv:ss->enames (ss / out idx)
(setq out nil)
(if ss
(progn
(setq idx 0)
(while (< idx (sslength ss))
(setq out (append out (list (ssname ss idx))))
(setq idx (1+ idx))
)
)
)
out
)
(defun brv:all-inserts (/ ss)
(brv:ss->enames (ssget "_X" '((0 . "INSERT"))))
)
(defun brv:all-inserts-by-effective-name (blockName / out e)
(setq out nil)
(foreach e (brv:all-inserts)
(if (= (brv:norm (brv:effective-name e)) (brv:norm blockName))
(setq out (append out (list e)))
)
)
out
)
(defun brv:sync-block-name (blockName / e)
(foreach e (brv:all-inserts-by-effective-name blockName)
(brv:sync-insert e)
)
)
(defun brv:sync-all (/ e count)
(setq count 0)
(foreach e (brv:all-inserts)
(if (or (brv:insert-installed-p e)
(brv:definition-has-attr-tag-p (brv:block-def-object e) "Видимость")
(brv:definition-has-attr-tag-p (brv:block-def-object e) "Видимость1"))
(progn
(brv:sync-insert e)
(setq count (1+ count))
)
)
)
(brv:println (strcat "Synced inserts: " (itoa count)))
(princ)
)
(defun brv:modified-callback (reactor params / obj ename)
(if (not brv:*syncing*)
(progn
(setq obj (car params))
(setq ename (vl-catch-all-apply 'vlax-vla-object->ename (list obj)))
(if (and (not (vl-catch-all-error-p ename)) ename)
(brv:sync-insert ename)
)
)
)
(princ)
)
(defun brv:clear-reactors ()
(foreach r brv:*reactors*
(if r (vl-catch-all-apply 'vlr-remove (list r)))
)
(setq brv:*reactors* nil)
)
(defun brv:attach-reactors (/ e obj)
(brv:clear-reactors)
(foreach e (brv:all-inserts)
(if (or (brv:insert-installed-p e)
(brv:definition-has-attr-tag-p (brv:block-def-object e) "Видимость")
(brv:definition-has-attr-tag-p (brv:block-def-object e) "Видимость1"))
(progn
(setq obj (brv:vla-object e))
(if (not (vl-catch-all-error-p obj))
(setq brv:*reactors*
(cons
(vlr-object-reactor
(list obj)
"BR_VIS_MINI"
'((:vlr-modified . brv:modified-callback))
)
brv:*reactors*
)
)
)
)
)
)
(brv:println (strcat "Visibility reactors attached: " (itoa (length brv:*reactors*))))
(princ)
)
(defun brv:dict-entry-ename (dict-ename key / hit)
(setq hit (dictsearch dict-ename (brv:str key)))
(if hit (cdr (assoc -1 hit)) nil)
)
(defun brv:delete-dict-entry (dict-ename key / rec ename)
(setq rec (dictsearch dict-ename (brv:str key)))
(if rec
(progn
(setq ename (cdr (assoc -1 rec)))
(dictremove dict-ename (brv:str key))
(if ename (entdel ename))
T
)
nil
)
)
(defun brv:put-xrecord (dict-ename key pairs / xrec)
(brv:delete-dict-entry dict-ename key)
(setq xrec
(entmakex
(append
'((0 . "XRECORD") (100 . "AcDbXrecord") (280 . 1))
(mapcar '(lambda (kv) (cons 1 (strcat (brv:str (car kv)) "=" (brv:str (cdr kv))))) pairs)
)
)
)
(if xrec (dictadd dict-ename (brv:str key) xrec))
xrec
)
(defun brv:get-xrecord (dict-ename key / ename data out item parsed)
(setq ename (brv:dict-entry-ename dict-ename key))
(setq out nil)
(if ename
(progn
(setq data (entget ename))
(foreach item data
(if (and (member (car item) '(1 1000))
(setq parsed (brv:parse-kv-string (cdr item))))
(setq out (cons parsed out))
)
)
)
)
(reverse out)
)
(defun brv:object-extdict-ename (obj / dictObj ename)
(setq dictObj (vl-catch-all-apply 'vla-GetExtensionDictionary (list obj)))
(if (vl-catch-all-error-p dictObj)
nil
(progn
(setq ename (vl-catch-all-apply 'vlax-vla-object->ename (list dictObj)))
(if (vl-catch-all-error-p ename) nil ename)
)
)
)
(defun brv:block-extdict-ename (blockObj)
(if blockObj (brv:object-extdict-ename blockObj) nil)
)
(defun brv:entity-extdict-ename (ename / data item dict in-xdict)
(setq data (entget ename))
(setq dict nil)
(setq in-xdict nil)
(foreach item data
(cond
((and (= (car item) 102) (= (cdr item) "{ACAD_XDICTIONARY"))
(setq in-xdict T))
((and (= (car item) 102) (= (cdr item) "}"))
(setq in-xdict nil))
((and in-xdict (= (car item) 360))
(setq dict (cdr item)))
)
)
dict
)
(defun brv:ensure-entity-extdict-ename (ename / dict newdict)
(setq dict (brv:entity-extdict-ename ename))
(if dict
dict
(progn
(setq newdict
(entmakex
'((0 . "DICTIONARY")
(100 . "AcDbDictionary")
(280 . 0)
(281 . 1))
)
)
(if (= (type newdict) 'ENAME)
(progn
(entmod
(append
(entget ename)
(list
(cons 102 "{ACAD_XDICTIONARY")
(cons 360 newdict)
(cons 102 "}")
)
)
)
(entupd ename)
(setq dict (brv:entity-extdict-ename ename))
(if dict dict newdict)
)
nil
)
)
)
)
(defun brv:insert-extdict-ename (ename / obj dict)
(setq dict (brv:ensure-entity-extdict-ename ename))
(if dict
dict
(progn
(setq obj (brv:vla-object ename))
(if (vl-catch-all-error-p obj)
nil
(brv:object-extdict-ename obj)
)
)
)
)
(defun brv:carrier-extdict-ename (ename / blockObj dict)
(setq dict (brv:insert-extdict-ename ename))
(if dict
dict
(progn
(setq blockObj (brv:block-def-object ename))
(if blockObj (brv:block-extdict-ename blockObj) nil)
)
)
)
(defun brv:file->string (path / f line first text)
(setq f (open path "r"))
(if f
(progn
(setq first T)
(setq text "")
(while (setq line (read-line f))
(if first (setq first nil) (setq text (strcat text "\n")))
(setq text (strcat text line))
)
(close f)
text
)
nil
)
)
(defun brv:string->lines (text / out pos next)
(setq out nil)
(setq pos 0)
(while (setq next (vl-string-search "\n" text pos))
(setq out (append out (list (substr text (+ pos 1) (- next pos)))))
(setq pos (1+ next))
)
(setq out (append out (list (substr text (+ pos 1)))))
out
)
(defun brv:write-text-file (path text / f line)
(setq f (open path "w"))
(if f
(progn
(foreach line (brv:string->lines text)
(write-line line f)
)
(close f)
T
)
nil
)
)
(defun brv:text->parts (text / out idx len size)
(setq out nil)
(setq idx 1)
(setq len (strlen text))
(setq size brv:*code-part-size*)
(while (<= idx len)
(setq out (append out (list (substr text idx (min size (- (+ len 1) idx))))))
(setq idx (+ idx size))
)
(if out out (list ""))
)
(defun brv:self-path (/ path)
(cond
(brv:*source-path* brv:*source-path*)
((setq path (findfile "BR_VIS_MINI.lsp")) path)
((setq path (findfile "BR_VIS_MINI")) path)
(T nil)
)
)
(defun brv:choose-self-path (/ picked)
(setq picked (getfiled "Select BR_VIS_MINI.lsp source" "" "lsp" 0))
(if picked
(progn
(setq brv:*source-path* picked)
picked
)
nil
)
)
(defun brv:resolve-self-path (/ path)
(setq path (brv:self-path))
(if path
path
(brv:choose-self-path)
)
)
(defun brv:embed-code-into-block (ename / dict path text parts idx key)
(setq dict (brv:carrier-extdict-ename ename))
(setq path (brv:resolve-self-path))
(cond
((not dict)
(brv:println "Cannot access block or insert extension dictionary. Code was not embedded.")
nil)
((not path)
(brv:println "Cannot find BR_VIS_MINI.lsp source. Code was not embedded.")
nil)
(T
(setq text (brv:file->string path))
(setq parts (brv:text->parts text))
(brv:put-xrecord dict brv:*dict-key-info*
(list
(cons "MODULE" "BR_VIS_MINI")
(cons "VERSION" brv:*version*)
(cons "DATE" (brv:timestamp))
(cons "BLOCKNAME" (brv:effective-name ename))
(cons "CARRIER" "BLOCK_OR_INSERT")
)
)
(brv:put-xrecord dict brv:*dict-key-code-count* (list (cons "COUNT" (itoa (length parts)))))
(setq idx 1)
(foreach part parts
(setq key (strcat brv:*dict-key-code-prefix* (substr (strcat "000" (itoa idx)) (- (strlen (strcat "000" (itoa idx))) 2))))
(brv:put-xrecord dict key (list (cons "TEXT" part)))
(setq idx (1+ idx))
)
(brv:println (strcat "Embedded BR_VIS_MINI into selected block carrier: " (brv:effective-name ename)))
T
)
)
)
(defun brv:embedded-code-from-block (ename / dict count idx key part out)
(setq dict (brv:carrier-extdict-ename ename))
(if (not dict)
nil
(progn
(setq count (brv:map-get "COUNT" (brv:get-xrecord dict brv:*dict-key-code-count*)))
(if count (setq count (atoi count)) (setq count 0))
(setq out "")
(setq idx 1)
(while (<= idx count)
(setq key (strcat brv:*dict-key-code-prefix* (substr (strcat "000" (itoa idx)) (- (strlen (strcat "000" (itoa idx))) 2))))
(setq part (brv:map-get "TEXT" (brv:get-xrecord dict key)))
(if part
(setq out (strcat out part))
(setq out (strcat out ""))
)
(setq idx (1+ idx))
)
(if (= out "") nil out)
)
)
)
(defun brv:install-path ()
(strcat (getenv "APPDATA") "\\" brv:*install-dir* "\\BR_VIS_MINI.lsp")
)
(defun brv:ensure-install-dir ()
(vl-mkdir (strcat (getenv "APPDATA") "\\" brv:*install-dir*))
)
(defun brv:restore-from-block (ename / text path)
(setq text (brv:embedded-code-from-block ename))
(if (not text)
(brv:println "No embedded BR_VIS_MINI code found in selected block definition.")
(progn
(brv:ensure-install-dir)
(setq path (brv:install-path))
(if (brv:write-text-file path text)
(progn
(load path nil)
(brv:println (strcat "Restored and loaded BR_VIS_MINI from block to: " path))
)
(brv:println "Cannot write restored LISP file.")
)
)
)
(princ)
)
(defun brv:install-block (ename / props count blockName)
(setq props (brv:visibility-props ename))
(setq count (length props))
(if (= count 0)
(progn
(brv:println "No visibility dynamic properties found. Nothing was installed.")
nil
)
(progn
(setq blockName (brv:effective-name ename))
(brv:ensure-hidden-attdefs ename count)
(brv:sync-block-name blockName)
(brv:embed-code-into-block ename)
(brv:attach-reactors)
(brv:println (strcat "Installed visibility attributes for block: " blockName))
T
)
)
)
(defun brv:show-help ()
(brv:println (strcat "BR_VIS_MINI " brv:*version* " help"))
(brv:println "")
(brv:println "Purpose:")
(brv:println " Writes dynamic block visibility state into hidden attributes.")
(brv:println " Attributes are invisible to the user, but available for data extraction.")
(brv:println "")
(brv:println "Commands:")
(brv:println " BRV-HELP / БРВ-ПОМОЩЬ")
(brv:println " Show this help.")
(brv:println " BRV-INSTALL / БРВ-УСТАНОВИТЬ")
(brv:println " Pick a dynamic block reference. Adds hidden attributes, writes current")
(brv:println " visibility values, embeds this mini-LISP into the selected insert")
(brv:println " carrier, and attaches reactors for the current drawing session.")
(brv:println " BRV-SYNC / БРВ-СИНХР")
(brv:println " Pick one installed insert and rewrite its visibility attributes.")
(brv:println " BRV-SYNC-ALL / БРВ-СИНХР-ВСЕ")
(brv:println " Rewrite visibility attributes for all installed inserts in the DWG.")
(brv:println " BRV-REACTORS / БРВ-РЕАКТОРЫ")
(brv:println " Reattach object reactors after opening a drawing or restoring code.")
(brv:println " BRV-EMBED / БРВ-ВСТРОИТЬ")
(brv:println " Embed the current BR_VIS_MINI.lsp source into the selected insert.")
(brv:println " BRV-RESTORE / БРВ-ВОССТАНОВИТЬ")
(brv:println " Restore embedded mini-LISP from selected insert to APPDATA and load it.")
(brv:println "")
(brv:println "Attribute rules:")
(brv:println " No visibility properties: no attributes are created.")
(brv:println " One visibility property: tag Видимость.")
(brv:println " Several visibility properties: tags Видимость1, Видимость2, ...")
(brv:println " Attribute value is rewritten when visibility state changes.")
(brv:println " Attribute definitions are invisible + preset.")
(brv:println "")
(brv:println "Detection rule:")
(brv:println " Dynamic property is treated as visibility when it has AllowedValues")
(brv:println " and its name contains Visibility or Видим.")
(brv:println "")
(brv:println "Transfer rule:")
(brv:println " Configured block carries hidden ATTDEF/ATTRIB data, xData marker,")
(brv:println " and embedded mini-LISP text in the selected insert extension dictionary.")
(brv:println " AutoCAD security should not auto-run arbitrary LISP from a block.")
(brv:println " On another machine load BR_VIS_MINI.lsp once through APPLOAD, or restore")
(brv:println " it with BRV-RESTORE when a bootstrap is already loaded. Then run")
(brv:println " BRV-REACTORS or BRV-SYNC-ALL.")
(princ)
)
(defun brv:cmd-install (/ ename)
(setq ename (brv:pick-insert "\nPick dynamic block to install visibility attribute mini-module: "))
(if ename (brv:install-block ename))
(princ)
)
(defun brv:cmd-sync (/ ename)
(setq ename (brv:pick-insert "\nPick installed dynamic block to sync: "))
(if ename (brv:sync-insert ename))
(princ)
)
(defun brv:cmd-embed (/ ename)
(setq ename (brv:pick-insert "\nPick block carrying mini-module: "))
(if ename (brv:embed-code-into-block ename))
(princ)
)
(defun brv:cmd-restore (/ ename)
(setq ename (brv:pick-insert "\nPick block with embedded BR_VIS_MINI code: "))
(if ename (brv:restore-from-block ename))
(princ)
)
(defun c:BRV-HELP () (brv:show-help))
(defun c:BRV-INSTALL () (brv:cmd-install))
(defun c:BRV-SYNC () (brv:cmd-sync))
(defun c:BRV-SYNC-ALL () (brv:sync-all))
(defun c:BRV-REACTORS () (brv:attach-reactors))
(defun c:BRV-EMBED () (brv:cmd-embed))
(defun c:BRV-RESTORE () (brv:cmd-restore))
(defun c:БРВ-ПОМОЩЬ () (brv:show-help))
(defun c:БРВ-УСТАНОВИТЬ () (brv:cmd-install))
(defun c:БРВ-СИНХР () (brv:cmd-sync))
(defun c:БРВ-СИНХР-ВСЕ () (brv:sync-all))
(defun c:БРВ-РЕАКТОРЫ () (brv:attach-reactors))
(defun c:БРВ-ВСТРОИТЬ () (brv:cmd-embed))
(defun c:БРВ-ВОССТАНОВИТЬ () (brv:cmd-restore))
(brv:attach-reactors)
(brv:println (strcat "BR_VIS_MINI " brv:*version* " loaded. Run BRV-HELP."))
(princ)