Конвертирование DWG-файла с заданной функцией преобразования строк

(defun ru-conv-file (quoted_func
                     /
                     audit_name
                     audit_names_list
                     blk
                     collection
                     collection_name
                     ename
                     ent
                     i
                     j
                     list_audit_names
                     list_new_names
                     main_block
                     name
                     names
                     names_list
                     new_names_list
                     obj
                     old_names_list
                     sub_list
                     _ent_modify
                     _make-names-list
                    )

;;; (ru-conv-file 'ru-conv-oem-to-ansi)
  ;|
В коллекции Textstyles могут быть пустые имена - это SHAPE!!!
|;

  (defun _ent_modify (ent dxf_code quoted_func is_print / old_value new_value)
    (if (assoc dxf_code ent)
      (progn
        (setq old_value (vl-princ-to-string (cdr (assoc dxf_code ent))))
        (if (= (type quoted_func) 'STR)
          (setq new_value quoted_func)
          (setq new_value ((eval quoted_func) old_value))
        ) ;_ end of if
        (if (and (/= old_value new_value)
                 (/= old_value "DEFPOINTS")
                 (/= old_value "0")
            ) ;_ end of and
          (progn
            (if (and is_print *ru_msg_debug*)
              (princ (strcat "
Изменяю значение для DXF-кода "
                             (itoa dxf_code)
                             " ["
                             old_value
                             "] на ["
                             new_value
                             "]
"
                     ) ;_ end of strcat
              ) ;_ end of princ
            ) ;_ end of if

            (setq ent (subst
                        (cons dxf_code new_value)
                        (cons dxf_code old_value)
                        ent
                      ) ;_ end of subst
            ) ;_ end of setq
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
    ent
  ) ;_ end of defun
  (defun _make-names-list ()
    (list (list "Layers" (ru-obj-list-layers))
          (list "Dimstyles" (ru-obj-list-dim-styles))
          (list "Textstyles" (ru-obj-list-textstyles))
          (list "Layouts" (ru-obj-list-layouts))
          (list "Blocks" (ru-obj-list-blocks))
          (list "Views" (ru-obj-list-views))
          (list "Viewports" (ru-obj-list-viewports))
          (list "Linetypes"
                (ru-obj-list-collection-member-names
                  (ru-obj-doc-collection "Linetypes")
                ) ;_ end of ru-obj-list-collection-member-names
          ) ;_ end of list
          (list "UserCoordinateSystems"
                (ru-obj-list-collection-member-names
                  (ru-obj-doc-collection "UserCoordinateSystems")
                ) ;_ end of ru-obj-list-collection-member-names
          ) ;_ end of ru-obj-list-collection-member-names
    ) ;_ end of list
  ) ;_ end of defun


;;;--------Главная функция -------------------------------------
  (setq old_names_list (_make-names-list))
  ;|



(("Layers" ("0" "”ЋђЊЂ’"
                "ѓђЂЌ?–›"
                "DEFPOINTS"
                "‘’…Ќ›"
           )
 )
  ("Dimstyles" ("Standard"))
  ("Textstyles" ("‘’ЂЌ„Ђђ’" "STANDARD" "ICAD"))
  ("Layouts" ("Layout1" "Model"))
  ("Blocks" ("*Model_Space"
              "*Paper_Space"
              "_TAMPUGL"
              "_STMPOSN"
              "RECTANG"
              "$ZN71"
              "_KVADRAT"
              "*X13"
              "*X14"
              "_LINE15000Њ"
            )
  )
  ("Views" nil)
  ("Viewports" ("*Active"))
  ("Linetypes" ("ByBlock" "ByLayer" "CONTINUOUS" "CENTER"))
  ("UserCoordinateSystems" nil)
)
(cdr (list "Textstyles" (list "‘’ЂЌ„Ђђ’" "STANDARD" "ICAD")))
|;
  (setq new_names_list
         (mapcar
           (function (lambda (names_list)
                       (list (car names_list)
                             (mapcar (function (lambda (name)
                                                 (if
                                                   name
                                                    ((eval quoted_func)
                                                      name
                                                    )
                                                    name
                                                 ) ;_ end of if
                                               ) ;_ end of lambda
                                     ) ;_ end of function
                                     (cadr names_list)
                             ) ;_ end of mapcar
                       ) ;_ end of list
                     ) ;_ end of lambda
           ) ;_ end of function
           old_names_list
         ) ;_ end of mapcar
  ) ;_ end of setq
  ;|
(("Layers" ("0" "ФОРМАТ"
                "ГРАНИЦЫ"
                "DEFPOINTS"
                "СТЕНЫ"
           )
 )
  ("Dimstyles" ("Standard"))
  ("Textstyles" ("СТАНДАРТ" "STANDARD" "ICAD"))
  ("Layouts" ("Layout1" "Model"))
  ("Blocks" ("*Model_Space"
              "*Paper_Space"
              "_TAMPUGL"
              "_STMPOSN"
              "RECTANG"
              "$ZN71"
              "_KVADRAT"
              "*X13"
              "*X14"
              "_LINE15000М"
            )
  )
  ("Views" nil)
  ("Viewports" ("*Active"))
  ("Linetypes" ("ByBlock" "ByLayer" "CONTINUOUS" "CENTER"))
  ("UserCoordinateSystems" nil)
)
|;

;;;--------------------------------------------------------------------------------------
  (vla-auditinfo (ru-obj-get-active-document) :vlax-true)
;;;--------------------------------------------------------------------------------------

  (setq audit_names_list
         (list (list "Layers" (ru-obj-list-layers))
               (list "Dimstyles" (ru-obj-list-dim-styles))
               (list "Textstyles" (ru-obj-list-textstyles))
               (list "Layouts" (ru-obj-list-layouts))
               (list "Blocks" (ru-obj-list-blocks))
               (list "Views" (ru-obj-list-views))
               (list "Viewports" (ru-obj-list-viewports))
               (list "Linetypes"
                     (ru-obj-list-collection-member-names
                       (ru-obj-doc-collection "Linetypes")
                     ) ;_ end of ru-obj-list-collection-member-names
               ) ;_ end of list
               (list "UserCoordinateSystems"
                     (ru-obj-list-collection-member-names
                       (ru-obj-doc-collection "UserCoordinateSystems")
                     ) ;_ end of ru-obj-list-collection-member-names
               ) ;_ end of ru-obj-list-collection-member-names
         ) ;_ end of list
  ) ;_ end of setq
  ;|
Такой же список, как до аудита, но переведенный
(("Layers" ("0" "AUDIT_I_040302232920-32"
                "AUDIT_I_040302232920-33"
                "DEFPOINTS"
                "AUDIT_I_040302232920-46"
           )
 )
  ("Dimstyles" ("Standard"))
  ("Textstyles" ("AUDIT_I_040302232920-47" "STANDARD" "ICAD"))
  ("Layouts" ("Layout1" "Model"))
  ("Blocks" ("*Model_Space"
              "*Paper_Space"
              "_TAMPUGL"
              "_STMPOSN"
              "RECTANG"
              "$ZN71"
              "_KVADRAT"
              "*X13"
              "*X14"
              "_LINE15000Њ"
            )
  )
  ("Views" nil)
  ("Viewports" ("*Active"))
  ("Linetypes" ("ByBlock" "ByLayer" "CONTINUOUS" "CENTER"))
  ("UserCoordinateSystems" nil)
)

|;

  (setq i 0)
  (foreach collection_list audit_names_list
    (setq collection_name
           (car collection_list)
          list_audit_names
           ;;Проник пустой
           ;; ("AUDIT_I_040303114528-57" "STANDARD" "ZCAD" "RUSS" "3" "2" "4" "TXT200" "1" "7" "5" "")

           (cadr collection_list)
          list_new_names
           (cadr (nth i new_names_list))
          i (1+ i)
          j 0
    ) ;_ end of setq
    (if list_new_names
      (progn
        (setq collection
               (ru-obj-doc-collection collection_name)
        ) ;_ end of setq
        (foreach name list_new_names
          (setq audit_name
                 (nth j list_audit_names)
                j (1+ j)
          ) ;_ end of setq
          (if *ru_msg_debug*
            (princ (strcat "
" audit_name "=" name))
          ) ;_ end of if
          ;; Для текстовых стилей
          (if (= collection_name "Textstyles")
            ;; В стилях могут быть пустые имена для SHAPE!!
            ;;(setq audit_name "" name "1")
            (if (and (/= audit_name "") (/= name ""))
              (command "_.-RENAME" "_Style" audit_name name)
            ) ;_ end of if
            (if
              (setq
                obj
                 (ru-obj-collection-item-by-name collection_name audit_name)
              ) ;_ end of setq
               (if (/= audit_name name)
                 (if (/= (substr audit_name 1 1) "*")
                   (ru-obj-put-name obj name)
                 ) ;_ end of if
               ) ;_ end of if
            ) ;_ end of if
          ) ;_ end of if
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of foreach



  (princ "
Обработка блоков...
")     ;
  (setq blk (tblnext "BLOCK" t))        ;
  (while blk                            ;
    ;; А теперь беремся за примитивы,
    ;; входящие в блок
    (setq ent (cdr (assoc -2 blk)))
    (while ent
      (setq ent (_ent_modify
                  (_ent_modify
                    (_ent_modify
                      (_ent_modify (entget ent) 1 quoted_func NIL)
                      2
                      quoted_func
                      NIL
                    ) ;_ end of _ent_modify
                    3
                    quoted_func
                    NIL
                  ) ;_ end of _ent_modify
                  4
                  quoted_func
                  NIL
                ) ;_ end of _ent_modify
      ) ;_ end of setq
      (entmod ent)
      (setq ent (entnext (cdr (assoc -1 ent)))) ;
    ) ;_ end of while
    (setq blk (tblnext "BLOCK"))
  ) ;_ end of while
  ;; Покончили с блоками, беремся за
  ;; объекты, плавающие на поверхности
  (setq ent (entnext))
  (princ "
Обработка примитивов...
")
  (while ent
    ;; И с каждым поступаем, как он того заслуживает
    (setq ent   (entget ent)
          ename (cdr (assoc 0 ent))
    ) ;_ end of setq
    (if (/= ename "SEQEND")
      (progn
        (setq ent (_ent_modify ent 1 quoted_func t))
        ;; Текст
        (if (/= ename "INSERT")
          ;; Это нельзя убирать!! Будет обратное переименование
          (setq ent (_ent_modify ent 2 quoted_func t))
          ;; Имя атрибута
        ) ;_ end of if
        (setq ent (_ent_modify ent 3 quoted_func t))
        ;; Значения текста
        (setq ent (_ent_modify ent 4 quoted_func t))
        (entmod ent)
      ) ;_ end of progn
    ) ;_ end of if
    (setq ent (entnext (cdr (assoc -1 ent))))
  ) ;_ end of while
  (command "_.REGEN")
;  (princ "
 Готово.
")
  (princ)
) ;_ end of defun