[Emasi]

Здравствуйте форумчане
есть такой вопрос. Можно ли написать лисп :
В чертеже бывает много позичии (в block reference). Эти позичии в этапах разработки чертеже надо изменить и входит сложности и потери времени. Извините с руским языком проблемы по этому я выложил файл в формете .dwg
Drawing4.dwg

[Alan]

Не понятен закон перенумерации блоков.
1-й вариант - это исходная нумерация?
2-й - это то, что надо получить?
Если последовательная (слева-направо, снизу-вверх или наоборот), то это обсуждалось и было много решений.

[Emasi]

Сообщение от Alan Не понятен закон перенумерации блоков. 1-й вариант - это исходная нумерация? 2-й - это то, что надо получить? Если последовательная (слева-направо, снизу-вверх или наоборот), то это обсуждалось и было много решений.

1. Да
2. Да
Я только хотел показать пример.
Знаете у нас в работе нумерачии делаются в block reference.По этому становиться проблема изменить нумерачию.
------------------------------------------------------------------------------------------------
Пример если я изменю 2 позицию (их много в чертеже ) на 12(их много в чертеже) то в чертеже будет Много 12 позичии .

[Alan]

Сообщение от Emasi 1. Да 2. Да Я только хотел показать пример. Знаете у нас в работе нумерачии делаются в block reference.По этому становиться проблема изменить нумерачию.

Всё равно не понял до конца...
Надо все номера 01 поменять на 03; 02 на 05; 03 на 01 и т.д.?
А не проще ли задавать эти номера при вставке блоков?

Пример если я изменю 2 позицию (их много в чертеже ) на 12(их много в чертеже) то в чертеже будет Много 12 позичии .

Аааа... добавили инфы. Немного проясняется. Надо подумать

[VVA]

Про нумерацию атрибутов:
Помогите плиз с программкой по автоматической нумерации
Автоматическое изменение атрибутов блоков
Automatically Label Attributes
Incremental Numbering Suite

[Emasi]

Значит так
Есть файл надо его доработать. Позиции уже все ставлени. вдруг надо изменить некоторые детали и их позичии ( позичии должны изменять ). И входит проблема если я изменю позию "х" на "y" одно временно позичия "y" уже тоже есть в файле и их много то я должен изменить местами "y" на "x".
Другая проблема есть файл каторый в доработке вдруг новый деталь и его нужно нумеровать уже сушестваюшим нумерачией : пример надо всатвить в файл 4-тую позичию 4 уже есть тогда существующий 4-тый позичия должна быть уже 5 (н+1, или н-1) и другие позичии должны изменятся .
Здесь я хочу штоб как я показал в dwg файле можно ли сделот так што я сам дал нумерачию каторый должен быть . Не легко передать свои мысли извините если што

[VVA]

Я так понял постановку:
В файле есть некоторое количество блоков с атрибутами. Атрибуты содержат целые числа (номера). И есть следующие залачи:
1. "Освободить номер". Указывается номер, и все блоки, у которых значения в атрибутах равны или больше указанного получают значение +1.
2. "Поменять местами". Указывается номер1 и номер2 и значения атрибутов меняются местами.
3. ?
По п.1 по быстрому слепил команду ATT+1

Код:

[Выделить все]

;;; URL http://forum.dwg.ru/showthread.php?t=76282
(defun get_setting ( )
  (list
  (cons "bname" "*") ;_Block name pattern
  (cons "attName" "P01");_Attrib tag name pattern
  )
  )
(defun C:ATT+1 ( / ss i lst  bname attName Numlist tmp align Num  )
  (setq align 2) ;_Add zero before number
  (mapcar
    'set
    '(bname attName)
    (list
      (cdr(assoc "bname" (get_setting)))
      (cdr(assoc "attName" (get_setting)))
      )
    )
  (if (and (setq ss (ssget "_X" (list '(0 . "INSERT") '(66 . 1)(cons 410 (getvar "ctab")))))
           (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      ) ;_ end of and
    (progn
      (setq i      0
            lst (mapcar 'vlax-ename->vla-object lst)
      ) ;_ end of setq
      (foreach blk lst
        (setq name (cond
                     ((and (vlax-property-available-p blk 'isdynamicblock)
                           (= (vla-get-isdynamicblock blk) :vlax-true)
                      ) ;_ end of and 
                      (vla-get-effectivename blk)
                     )
                     (t (vla-get-name blk))
                   ) ;_ end of cond
              i    (1+ i)
        ) ;_ end of setq 
        (if
          (and (wcmatch (strcase name) (strcase bname))
               (setq tmp(assoc(strcase attname)(GET-ALL-ATTS blk)))
          ) ;_ end of and
           (progn
             (setq Numlist (cons(cons (cdr tmp)(list blk)) Numlist))
             )
          )
        )
      (if (setq Num
                 (car
                   (_DWGRU-GET-USER-DCL "Select increment number"
                     (RemoveDuplicateStrings
                       (SORTSTRINGWITHNUMBERASNUMBER (mapcar 'car Numlist) nil)
                       )
                     nil
                     )
                   )
                )
        (progn
          (setq Num (atoi Num))
          (mapcar
            '(lambda(z)
               (mip-block-setattr-bylist
                 (cadr z)
                 (list
                   (cons attName (car z))
                   )
                 )
               )
          (mapcar
            '(lambda(y / str)
               (setq str (itoa (car y)))
               (while (< (strlen str) align)
                 (setq str (strcat "0" str))
                 )
               (list str (cadr y))
               )
          (mapcar
            '(lambda(x)
               (if
                 (>= (atoi (car x)) Num)
                 (list (1+ (atoi (car x))) (cadr x))
                 (list (atoi (car x))(cadr x))
                 )
               )
            Numlist
          )
            )
            )
         )
        )
      )
    )
  (princ)
  )
(defun mip-block-setattr-bylist (obj att_list / txt lst)
  (if (= (type obj) 'ENAME)
    (setq obj (vlax-ename->vla-object obj))
  ) ;_ end of if
  (setq att_list (mapcar '(lambda (x)
                            (cons (strcase (mip-conv-to-str (car x)))
                                  (mip-conv-to-str (cdr x))
                            ) ;_ end of cons
                          ) ;_ end of lambda
                         att_list
                 ) ;_ end of mapcar
  ) ;_ end of setq
  (if (and obj
           (not (vlax-erased-p obj))
           (= (vla-get-objectname obj) "AcDbBlockReference")
           (eq :vlax-true (vla-get-hasattributes obj))
           (vlax-property-available-p obj 'Hasattributes)
           (vlax-write-enabled-p obj)
      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (foreach at (vlax-invoke obj 'Getattributes)
            (if (setq
                  lst (assoc (strcase (vla-get-tagstring at)) att_list)
                ) ;_ end of setq
              (vla-put-textstring at (cdr lst))
            ) ;_ end of if
          ) ;_ end of foreach
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun
(defun get-all-atts (obj)
  (if (and obj
           (eq :vlax-true (vla-get-hasattributes obj))
           (vlax-property-available-p obj 'Hasattributes)

      ) ;_ end of and
    (vl-catch-all-apply
      (function
        (lambda ()
          (mapcar (function (lambda (x)
                              (cons (vla-get-tagstring x)
                                    (vla-get-textstring x)
                              ) ;_ end of cons
                            ) ;_ end of lambda
                  ) ;_ end of function
                  (append (vlax-invoke obj 'Getattributes)
                          (vlax-invoke obj 'Getconstantattributes)
                  ) ;_ end of append
          ) ;_ end of mapcar
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  ) ;_ end of if
) ;_ end of defun  
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  ;;;http://www.theswamp.org/index.php?topic=16564.msg207439;topicseen#msg207439
  ;;; http://www.theswamp.org/index.php?topic=6474.0
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
	 (setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by 
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
)
;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2008  DWGru Programmers Group
;;; *
;;; * _dwgru-get-user-dcl (Кандидат)
;;; *
;;; * Запрос значения у пользователя через диалоговое окно
;;; *
;;; *
;;; * 26/01/2008 Версия 0002. Редакция Владимир Азарко (VVA)
;;;              - Выход по двойному клику, если запрещен множественный выбор (multi-nil)
;;;              - Обработка нескольких колонок
;;; * 21/01/2008 Версия 0001. Редакция Владимир Азарко (VVA)
;;; ************************************************************************


;;; ************************************************************************
;;; * Library DWGruLispLib Copyright © 2008 DWGru Programmers Group
;;; *
;;; * _dwgru-get-user-dcl (Candidate)
;;; *
;;; * Inquiry of value at the user through a dialogue window
;;; *
;;; *
;;; * 26/01/2008 Version 0002. Edition Vladimir Azarko (VVA)
;;; - the Output on double a clique if the plural choice (multi-nil) is forbidden
;;; - Processing of several columns
;;; * 21/01/2008 Version 0001. Edition Vladimir Azarko (VVA)


(defun _DWGRU-GET-USER-DCL (ZAGL        INFO-LIST   MULTI
                            /           FL          RET
                            DCL_ID      MAXROW      MAX_COUNT_COL
                            COUNT_COL   I           LISTBOX_HEIGHT
                            LST         _LOC_FINISH _LOC_CLEAR
                            NCOL tmp
                           )
;| 
* ENGLISH
* Inquiry of value at the user through a dialogue window
* Dialogue is formed to "strike"
* the Quantity of lines on page without scrolling is set by variable MAXROW.
* It is necessary to remember, that number MAXROW increases on 3.
* the Maximum quantity of columns is set by variable MAX_COUNT_COL
* It is published
     http://dwg.ru/f/showthread.php?p=203746#post203746
* Parameters of a call:
    zagl - heading of a window [String]
    info-list - the list of line values[List of String]
    multi - t - the plural choice is resolved, nil-is not present
      
* Returns:
 The list of the chosen lines or nil - a cancelling
* the Example
 (_dwgru-get-user-dcl " Specify a variant " ' ("First" "Second" "Third") nil); _-> ("First") 
 (_dwgru-get-user-dcl " Specify a variant " ' ("First" "Second" "Third") t); _-> ("First"  "Second ")
 (_dwgru-get-user-dcl " Specify a variant "
   (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) nil)
 (_dwgru-get-user-dcl " Specify a variant, using CTRL and SHIFT for a choice "
   (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) t)
|;
;|
* RUS						   
* Запрос значения у пользователя через диалоговое окно
* Диалог формируется "налету"
* Количество строк на страницу без скроллинга задается переменной MAXROW.
* Необходимо помнить, что число MAXROW увеличивается на 3.
* Максимальное количество колонок задается переменной MAX_COUNT_COL
* Опубликована
     http://dwg.ru/f/showthread.php?p=203746#post203746
* Параметры вызова:
    zagl - заголовок окна [String]
    info-list - список строковых значений[List of String]
    multi - t - разрешен множественный выбор, nil- нет
    
* Возвращает:
 Список выбранных строк или nil - отмена
* Пример
 (_dwgru-get-user-dcl "Укажите вариант" '("Первый" "Второй" "Третий") nil) ;_->("Первый") 
 (_dwgru-get-user-dcl "Укажите вариант" '("Первый" "Второй" "Третий") t) ;_->("Первый" "Второй")
 (_dwgru-get-user-dcl "Укажите вариант"
   (progn (setq i 0 lst nil)(repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1+ i)))) lst)))(reverse lst)) nil)
 (_dwgru-get-user-dcl "Укажите вариант, используя CTRL и SHIFT для выбора"
   (progn (setq i 0 lst nil)(repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1+ i)))) lst)))(reverse lst)) t)
|;
 ;_ ===== КОНСТАНТЫ ============

  (setq MAXROW 40) ;_макc. кол-во строк без скроллинга (К нему дальше добавится еще 3 строчки)
                   ;_  max lines without scrolling (To it 3 more lines further will be added)
  (setq MAX_COUNT_COL 5) ;_максимальное количество колонок
                         ;_ ; _ a maximum quantity of columns
;;============== Локальные фунцкции START==================
;;============== Local functions START========================

  (defun _LOC_FINISH ()
    (setq I   0
          RET NIL
    ) ;_ end ofsetq
    (repeat COUNT_COL
      (setq I (1+ I))
      (setq RET (cons (cons I (get_tile (strcat "info" (itoa I)))) RET))
    ) ;_ end ofrepeat
    (setq RET (reverse RET))
    (done_dialog 1)
  ) ;_ end ofdefun
  (defun _LOC_ERR-TILE (what)
    ;;;what - string or nil
    (if what
      (set_tile "error" what)
    (if MULTI
        (set_tile "error"
                  (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
                    "Используйте CTRL и SHIFT для выбора"
                    "Use CTRL and SHIFT for a choicet"
                  ) ;_ end ofif
        ) ;_ end ofset_tile
        (set_tile "error"
                  (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
                    "Можно выбирать двойным щелчком"
                    "It is possible to choose double click"
                  ) ;_ end ofif
        ) ;_ end ofset_tile
      ) ;_ end ofif
      )
    )
  (defun _LOC_CLEAR (NOMER)
    (setq I 0)
    (repeat COUNT_COL
      (setq I (1+ I))
      (if (/= I NOMER)
        (progn
          (start_list (strcat "info" (itoa I)))
          (mapcar 'add_list (nth (1- I) LST))
          (end_list)
        ) ;_ end ofprogn
      ) ;_ end ofif
    ) ;_ end ofrepeat
  ) ;_ end ofdefun

;;;==================== Локальные фунцкции END ==================================
;;;==================== Local functions END ==================================

;;;==================== MAIN PART ===============================================

  (if (null ZAGL)
    (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
      (setq ZAGL "Выбор")
      (setq ZAGL "Select")
    ) ;_ end ofif
  ) ;_ end if
  (if (zerop (rem (length INFO-LIST) MAXROW)) ;_Целое количество столбцов
    (setq COUNT_COL (/ (length INFO-LIST) MAXROW)) ;_Его и оставляем
    (setq COUNT_COL (1+ (fix (/ (length INFO-LIST) MAXROW 1.0)))) ;_Берем ближайшее целое
  ) ;_ end ofif
  (if (> COUNT_COL MAX_COUNT_COL)
    (setq COUNT_COL MAX_COUNT_COL)
  ) ;_Ограничиваем max количеством
  (setq LISTBOX_HEIGHT (+ 3 MAXROW)) ;_  добавляем 3 строчки для красоты и для исключения пограничного скроллинга
                                     ;_ We add 3 lines for appearance and for exception boundary scroll
  (if (and (= COUNT_COL 1) (<= (length INFO-LIST) MAXROW))
    (setq LISTBOX_HEIGHT (+ 3 (length INFO-LIST)))
  ) ;_ end ofif
  (setq I 0)
  (setq FL (vl-filename-mktemp "dwgru" NIL ".dcl"))
  (setq RET (open FL "w")
        LST NIL
  ) ;_ end ofsetq
  (mapcar '(lambda (X) (write-line X RET))
          (append (list "dwgru_get_user : dialog { "
                        (strcat "label=\"" ZAGL "\";")
                        ": boxed_row {"
                        (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
                          "label = \"Значение\";"
                          "label = \"Value\";"
                        ) ;_ end ofif
                  ) ;_ end oflist
                  (repeat COUNT_COL
                    (setq LST
                           (append
                             LST
                             (list
                               " :list_box {"
                               "alignment=top ;"
                               (if MULTI
                                 "multiple_select = true ;"
                                 "multiple_select = false ;"
                               ) ;_ end ofif
                               (strcat
                               "width="
                               (itoa
                               ((lambda(len)
                                  (setq len
                                  (cond ((and
                                           (< COUNT_COL 3)
                                           (< len 93)
                                           )
                                         len
                                         )
                                        ((and
                                           (> COUNT_COL 2)
                                           (< len 73)
                                           )
                                         len
                                         )
                                        (t 41)
                                        )
                                        )
                                  (if (< len 25) 25 len)
                                  )
                                 (apply 'max (mapcar 'strlen info-list))
                                 )
                               )
                               ";"
                               )
                               (strcat "height= " (itoa LISTBOX_HEIGHT) " ;")
                               "is_tab_stop = false ;"
                               (strcat "key = \"info" (itoa (setq I (1+ I))) "\";}")
                             ) ;_ end oflist
                           ) ;_ end ofappend
                    ) ;_ end ofsetq
                  ) ;_ end ofrepeat
                  (list
                    "}"
                    ":row{"
                    "ok_cancel_err;}}"
                  ) ;_ end oflist
          ) ;_ end of list
  ) ;_ end of mapcar
  (setq RET (close RET))
  (if (and (null (minusp (setq DCL_ID (load_dialog FL))))
           (new_dialog "dwgru_get_user" DCL_ID)
      ) ;_ end and
    (progn
      (setq LST INFO-LIST)
      ((lambda (/ RET1 BUF ITM)

         (repeat (1- COUNT_COL)
           (setq I '-1)
           (while (and (setq ITM (car LST))
                       (< (setq I (1+ I)) MAXROW)
                  ) ;_ end ofand
             (setq BUF (cons ITM BUF)
                   LST (cdr LST)
             ) ;_ end ofsetq
           ) ;_ end ofwhile
           (setq RET1 (cons (reverse BUF) RET1)
                 BUF  NIL
           ) ;_ end ofsetq
         ) ;_ end ofrepeat
         (setq RET RET1)
       ) ;_ end oflambda
      )
      (if LST
        (setq RET (cons LST RET))
      ) ;_ end ofif
      (setq LST (reverse RET))
      (setq I 0)
      (mapcar '(lambda (THIS_LIST)
                 (if (<= (setq I (1+ I)) COUNT_COL)
                   (progn
                     (start_list (strcat "info" (itoa I)))
                     (mapcar 'add_list THIS_LIST)
                     (end_list)
                   ) ;_ end ofprogn
                 ) ;_ end ofif
               ) ;_ end oflambda
              LST
      ) ;_ end ofmapcar

      (set_tile "info1" "0")
      (setq I 0
            NCOL 1
      ) ;_ end ofsetq
      (repeat COUNT_COL
        (action_tile
          (strcat "info" (itoa (setq I (1+ I))))
          (strcat "(progn (if (= $reason 1)(_LOC_ERR-TILE (nth (atoi(get_tile \"info1\")) info-list))(_LOC_ERR-TILE nil)) (setq Ncol "
                  (itoa I)
                  ")(if (not multi)(_loc_clear Ncol))"
                  "(if (and (not multi)(= $reason 4))(_loc_finish)))"
          ) ;_ end ofstrcat
        ) ;_ end ofaction_tile
      ) ;_ end ofrepeat
      (action_tile "cancel" "(done_dialog 0)")
      (action_tile "accept" "(_loc_finish)")
      (_LOC_ERR-TILE nil)
      (if (zerop (start_dialog))
        (setq RET NIL)
        (progn
          (setq
            RET (apply
                  'append
                  (mapcar
                    '(lambda (ITM)
                       (setq THIS_LIST (nth (1- (car ITM)) LST))
                       (mapcar
                         (function (lambda (NUM) (nth NUM THIS_LIST)))
                         (read (strcat "(" (cdr ITM) ")"))
                       ) ;_ end ofmapcar
                     ) ;_ end oflambda
                    RET
                  ) ;_ end ofmapcar
                ) ;_ end ofapply
          ) ;_ end ofsetq

        ) ;_ end ofprogn
      ) ;_ end if
      (unload_dialog DCL_ID)
    ) ;_ end of progn
  ) ;_ end of if
  (vl-file-delete FL)
  RET
) ;_ end ofdefun
(defun RemoveDuplicateStrings (stringlist / newlist)
  (foreach var stringlist 
    (if (not (vl-position var newlist))
      (setq newlist (cons var newlist))
    )
  )
  (reverse newlist)
)
    (defun mip-conv-to-str (dat)
      (cond ((= (type dat) 'INT) (setq dat (itoa dat)))
            ((= (type dat) 'REAL) (setq dat (rtos dat 2 12)))
            ((null dat) (setq dat ""))
            (t (setq dat (vl-princ-to-string dat)))
      ) ;_ end of cond
    ) ;_ end of defun

(princ "\nType ATT+1 in command line")
(vl-load-com)

[Oliver_88]

Сообщение от Emasi так што я сам дал нумерачию каторый должен быть

Для твоего примера. Сам сочиняешь список вида

Код:

[Выделить все]

 '(
("01" "03") ("02" "05") ("03" "01") ("04" "04") ("05" "02")
	("06" "08") ("07" "10") ("08" "06") ("09" "09") ("10" "07")
	)

где ("x" "y") x - старый номер(обозначение),y - новый номер.

Код:

[Выделить все]

 (defun test (g_lst / bes-add-vla-object-selectionset *active_document*)
  (vl-load-com)
  (setq
    *active_document* (vla-get-activedocument (vlax-get-acad-object))
    )
  (defun bes-add-vla-object-selectionset (lst scr doc / ssl)
    (setq ssl
	   (vla-get-ActiveSelectionSet
	     doc
	     )
	  )
    (vla-Clear ssl)
    (if scr
      (if
	(and
	  (not
	    (vl-catch-all-error-p
	      (vl-catch-all-apply
		'vla-SelectOnScreen
		(list ssl
		      (vlax-safearray-fill
			(vlax-make-safearray
			  vlax-vbInteger
			  (cons 0 (1- (vl-list-length lst)))
			  )
			(mapcar 'car lst)
			)
		      (vlax-safearray-fill
			(vlax-make-safearray
			  vlax-vbVariant
			  (cons 0 (1- (vl-list-length lst)))
			  )
			(mapcar 'cdr lst)
			)
		      )
		)
	      )
	    )
	  (/= (vla-get-Count ssl) 0)
	  )
	ssl
	)
      (if
	(and
	  (not
	    (vl-catch-all-error-p
	      (vl-catch-all-apply
		'vla-Select
		(list ssl
		      acSelectionSetAll
		      nil nil
		      (vlax-safearray-fill
			(vlax-make-safearray
			  vlax-vbInteger
			  (cons 0 (1- (vl-list-length lst)))
			  )
			(mapcar 'car lst)
			)
		      (vlax-safearray-fill
			(vlax-make-safearray
			  vlax-vbVariant
			  (cons 0 (1- (vl-list-length lst)))
			  )
			(mapcar 'cdr lst)
			)
		      )
		)
	      )
	    )
	  (/= (vla-get-Count ssl) 0)
	  )
	ssl
	)
      )
    )
  
  (mapcar
    (function
      (lambda (s)
	(mapcar
	  (function
	    (lambda (f)
	      (vla-put-TextString
		f
		(car s)
		)
	      )
	    )
	  (cdr s)
	  )
	)
      )
    (mapcar
      (function
	(lambda (x / sel lst)
	  (setq sel (bes-add-vla-object-selectionset
		      '((0 . "INSERT"))
		      nil
		      *active_document*
		      )
		)
	  (vlax-map-collection sel
	    (function
	      (lambda (a)
		(if
		  (equal
		    :vlax-true
		    (vla-get-HasAttributes
		      a
		      )
		    )
		  (if
		    (equal
		      (car x)
		      (vla-get-TextString
			(setq attr
			       (car
				 (vlax-safearray->list(vlax-variant-value(vla-Getattributes a)))
				 )
			      )
			)
		      )
		    (setq lst (cons attr lst))
		    )
		  )
		)
	      )
	    )
	  (cons
	    (cadr x)
	    lst
	    )
	  )
	)
      g_lst
      )
    )
  )

Вызов функции для твоего примера

Код:

[Выделить все]

 (test '(("01" "03") ("02" "05") ("03" "01") ("04" "04") ("05" "02")
	("06" "08") ("07" "10") ("08" "06") ("09" "09") ("10" "07")
	)
      )

[Emasi]

VVA - Вот такой еror выходит --- ; error: no function definition: MIP-CONV-TO-STR

Oliver_88 - спасибо вещь то что надо.

всем благодарю за труд

[VVA]

Сообщение от Emasi VVA - Вот такой еror выходит --- ; error: no function definition: MIP-CONV-TO-STR

добавил в #7