(vl-load-com)
(defun adn-save-settings ()
(setq *adn-doc* (vla-get-activedocument (vlax-get-acad-object))
*adn-settings* (append (mapcar (function (lambda (x / o)
(list (cons "name" (car x))
(cons "obj" (setq o (vlax-get-property *adn-doc* (car x))))
(cons "count" (vla-get-count o))
(cons "crit" (cdr x))
) ;_ end of list
) ;_ end of lambda
) ;_ end of function
;; Первый элемент в точечной паре - имя свойства документа
;; Второй - критичная разница между стартом и последним сохранением
'
(("registeredapplications" . 20)
;; Следующие элементы - для примера
("textstyles" . 10)
("dimstyles" . 10)
)
) ;_ end of mapcar
(mapcar (function
(lambda (x / d)
(list (cons "name" (car x))
(cons "obj"
(setq d (vl-catch-all-apply (function (lambda () (vla-item (vla-get-dictionaries *adn-doc*) (car x))))))
) ;_ end of cons
(cons "count"
(if (and (= (type d) 'vla-object) (vlax-property-available-p d 'count))
(vla-get-count d)
0
) ;_ end of if
) ;_ end of cons
(cons "crit" (cdr x))
) ;_ end of list
) ;_ end of lambda
) ;_ end of function
;; Первый элемент в точечной паре - имя словаря
;; Второй - критичная разница между стартом и последним сохранением
'
(("acad_scalelist" . 15) ("acad_dgnlinestylecomp" . 0))
) ;_ end of mapcar
) ;_ end of append
) ;_ end of setq
) ;_ end of defun
(adn-save-settings)
(if *adn-vlr-cmd*
(progn (vl-remove *adn-vlr-cmd*) (setq *adn-vlr-cmd* nil))
) ;_ end of if
(if (not *adn-vlr-cmd*)
(setq *adn-vlr-cmd* (vlr-command-reactor "adn-cmd-reactor" '((:vlr-commandwillstart . _adn-vlr-cmd-start))))
) ;_ end of if
(defun _adn-vlr-cmd-start (react cmd / datas)
(setq cmd (strcase (car cmd)))
(cond
((member cmd '("QSAVE" "SAVE" "SAVEAS"))
(if (setq datas
(vl-remove-if
(function (lambda (x) (or (not x) (not (cdr (assoc "count" x))) (< (cdr (assoc "count" x)) 0))))
(mapcar (function
(lambda (item / o)
(cond ((and (= (type (setq o (cdr (assoc "obj" item)))) 'vla-object) (vlax-property-available-p o 'count))
(list (assoc "name" item)
(cons "count" (- (vla-get-count o) (cdr (assoc "count" item)) (cdr (assoc "crit" item))))
) ;_ end of list
)
((and (/= (type (cdr (assoc "obj" item))) 'vla-object)
(= (type
(setq o (vl-catch-all-apply
(function (lambda () (vla-item (vla-get-dictionaries *adn-doc*) (cdr (assoc "name" item)))))
) ;_ end of vl-catch-all-apply
) ;_ end of setq
) ;_ end of type
'vla-object
) ;_ end of =
(vlax-property-available-p o 'count)
) ;_ end of and
(list (assoc "name" item) (- (cons "count" (vla-get-count o)) (cdr (assoc "crit" item))))
)
((and (/= (type (cdr (assoc "obj" item))) 'vla-object)
(= (type
(setq o (vl-catch-all-apply (function (lambda () (vlax-get-property *adn-doc* (cdr (assoc "name" item)))))))
) ;_ end of type
'vla-object
) ;_ end of =
(vlax-property-available-p o 'count)
) ;_ end of and
(list (assoc "name" item)
(cons "count"
(- (vla-get-count o)
(cond ((cdr (assoc "count" item)))
(t 0)
) ;_ end of cond
(cdr (assoc "crit" item))
) ;_ end of -
) ;_ end of cons
) ;_ end of list
)
) ;_ end of cond
) ;_ end of lambda
) ;_ end of function
*adn-settings*
) ;_ end of mapcar
) ;_ end of vl-remove-if
) ;_ end of setq
(alert
(strcat "При сохранении файла обнаружены следующие превышения"
"\nс момента последнего сохранения"
(apply (function strcat)
(mapcar (function
(lambda (x / o)
(strcat "\n"
(if (= (type
(setq o (vl-catch-all-apply
(function (lambda () (vla-item (vla-get-dictionaries *adn-doc*) (cdr (assoc "name" x)))))
) ;_ end of vl-catch-all-apply
) ;_ end of setq
) ;_ end of type
'vla-object
) ;_ end of =
"Словарь"
"Свойство"
) ;_ end of if
" \""
(cdr (assoc "name" x))
"\" : "
(itoa (cdr (assoc "count" x)))
) ;_ end of strcat
) ;_ end of lambda
) ;_ end of function
datas
) ;_ end of mapcar
) ;_ end of apply
"\n\n"
"Выполните очистку файла!"
) ;_ end of strcat
) ;_ end of alert
) ;_ end of if
;; Если сравнивать надо не с последним сохранением, а с начальным состоянием,
;; следующую строку надо будет удалить
(adn-save-settings)
)
) ;_ end of cond
) ;_ end of defun
