Программа для контроля использованных материалов

(if (regapp "VolumeControl") (princ"\nVolumeControl\n")) ; Регистрация приложения
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Подсчет длины примитивов на указанном слое или списке слоев;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Get_Sum_Dist (Layers_List / Sset Sum i Curve old_error StartParam EndParam)
  (setq old_error *error*)
  (defun *error* (msg)
    (setq *error* old_error)
    (mapcar '(lambda (x) (setq x nil)) (list Sset Sum i Curve old_error))
    (gc) (gc)
    (princ (strcat "\nError: " msg " WTF"))
    (princ)
  ); end *error*
  (if (listp Layers_List)
    (progn
      (setq SSet (ssget "_X" (append '((-4 . "<OR")) (mapcar '(lambda (x) (cons 8 x)) Layers_List) '((-4 . "OR>")))))
      (setq Sum 0 i 0)
      (repeat (sslength SSet)
    (setq Curve (vlax-ename->vla-object (ssname SSet i))
              i (1+ i)
          StartParam (vl-catch-all-apply 'vlax-curve-getStartParam (list Curve))
          EndParam (vl-catch-all-apply 'vlax-curve-getEndParam (list Curve))
              Sum (+ Sum (if (not (and (vl-catch-all-error-p StartParam) (vl-catch-all-error-p EndParam))) (vlax-curve-getdistatparam Curve (- EndParam StartParam)) 0))
      ))
      Sum
    )  ;end progn
    0;else expr
  ));end defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Функция обновления значений;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun C:text_upd ate ( / SStext text_with_xdata i old_error)
   (setq old_error *error*)
   (defun *error* (msg)
     (setq *error* old_error)
     (mapcar '(lambda (x) (setq x nil)) (list SStext text_with_xdata i old_error))
     (gc) (gc)
     (princ (strcat "\nError: " msg " WTF"))
     (princ)
   );end error
  (setq SStext (ssget "_X" (append '((-4 . "<OR")) (mapcar '(lambda (x) (cons 0 x)) '("TEXT" "MTEXT")) '((-4 . "OR>"))))
    i 0)
;;;удаление примитивов без xdata и формирование списка e-name
  (repeat (sslength SStext)
       (if (xdata_read (ssname SStext i) 1000 "VolumeControl")
       (setq text_with_xdata (cons (ssname SStext i) text_with_xdata)))
       (setq i (1+ i))
  )
  (foreach i text_with_xdata (vla-put-textstring (vlax-ename->vla-object i) (Get_Sum_Dist (read (xdata_read i 1000 "VolumeControl")))))
  (setq *error* old_error)
  (princ "\nUpd ate complete")
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;   Ассоциация текстовых строк    ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:associate ( / text_object set_of_ents index list_of_layers old_error item string)
  (setq old_error *error*)
  (defun *error* (msg)
    (setq *error* old_error)
    (mapcar '(lambda (x) (setq x nil)) (list text_object set_of_ents index list_of_layers old_error item string))
    (gc) (gc)
    (princ (strcat "\nError: " msg " WTF"))
    (princ)
  ); end *error*
  (setq text_object (car (entsel "\nSelect text to be associated:")))
  (if (or (= (cdr (assoc 0 (entget text_object))) "TEXT") (= (cdr (assoc 0 (entget text_object))) "MTEXT"))
    (progn
      (princ "\nSelect object(s) on destination layer(s):")
      (setq set_of_ents (ssget)
            index 0
            list_of_layers '())

      (repeat (sslength set_of_ents)
         (if (not (member (cdr (assoc 8 (entget (ssname set_of_ents index)))) list_of_layers))
           (setq list_of_layers (cons (cdr (assoc 8 (entget (ssname set_of_ents index)))) list_of_layers))
         )
       (setq index (1+ index))
      )
;;;;;;;;;склейка списка в строку
      (setq string "(")
      (foreach item list_of_layers (setq string (strcat string "\"" item "\"")))
      (setq string (strcat string ")"))
;;;;;;;;;Запись в Хdata строки со списком слоев
      (xdata_write text_object 1000 string "VolumeControl")
    )
    (princ "\nThe selected object is not a text\n")
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;тест
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:stringTest ( / string)
     (if (setq string (xdata_read (car (entsel "\nSelect text to be checked:")) 1000 "VolumeControl"))
      (princ (strcat "\nThe selected string is associated with layer(s) - " string))
      (princ "\nAssociation not found")
     )
  (princ)
)

(defun C:helpme ( / )
  (princ "\nTo associate text with layer(s) type ASSOCIATE and follow instructions in command line")
  (princ "\nTo check if there is association type STRINGTEST and follow instructions in command line")
  (princ)
)

;;;*********************************************************
;;;
;;;ФУНКЦИЯ ЧТЕНИЯ ИЗ РАСШИРЕННЫХ ДАННЫХ ПРИМИТИВА
;;;
;;; Функция читает расширенные данные из примитива
;;;
;;;*********************************************************
(defun xdata_read (wantedEnt  ;- метка примитива откуда считываються Х-Данные
                   wantedDXF  ;- код DXF группы где хранятся данные
                   App  ;- приложение для которого читаются расширенные данные
                  /)
  (cdr(assoc wantedDXF (cdadr(assoc -3 (entget wantedEnt (list App)))))) ;- считать данные из нужной группы
); end SC_XData_Read

;;;*********************************************************
;;;
;;;  ФУНКЦИЯ ЗАПИСИ В РАСШИРЕННЫЕ ДАННЫЕ ПРИМИТИВОВ
;;;
;;; Функция вносит значениея расширенных данных в примитивы
;;;
;;;*********************************************************
(defun xdata_write (wantedEnt  ;- метка примитива куда вносятся Х-Данные
                    wantedDXF  ;- код DXF группы куда записываются данные
                    writeData  ;- записываемые данные
                    App             ;- приложение для которого читаются расширенные данные
                   / clearDXF  ;- исходный список DXF кодов примитива
                     extData    ;- расширенные данные
                     extList    ;- список расширенных данных без признака и имени приложения
                   )
(setq clearDXF (entget wantedEnt)) ; получить DXF коды примитива
(setq extList (vl-remove App (cadr(assoc -3 (entget wantedEnt (list App)))))) ; выделить данные без  названия приложения
  (if extList ; если данные есть
    (progn
    (if (assoc wantedDXF extList) ; если в данных уже содержиться нужная группа
      (setq extList (append (list (cons wantedDXF writeData)) ; присоединить новые данные
         (vl-remove (assoc wantedDXF extList) extList))); в список с удаленными старыми данными
      (setq extList (append (list (cons wantedDXF writeData)) extList)) ; если нужной группы нет, присоединить ее
      ); end if
      ); end progn
      (se tq extList (list (cons wantedDXF writeData))) ; если данных нет создать их из одной группы
    ); end if
(se tq extData (append (list -3) (list (append (list App) extList)))) ; добавить признак наличия и имя приложения
  (entmod (append clearDXF (list extData))) ; обновить примитив с учетом новых данных
    (princ)
); end of SC_XData_Record