Загрузка данных


;;; 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)