| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Проблема с передачей длины LINE в атрибуты блока

Проблема с передачей длины LINE в атрибуты блока

Ответ
Поиск в этой теме
Непрочитано 15.09.2021, 17:23 #1
Проблема с передачей длины LINE в атрибуты блока
Сыч
 
Регистрация: 05.04.2011
Сообщений: 26

Здравствуйте.
Решил реализовать следующую задачу: на чертеже выбираются несколько отрезков и полилиний, выбирается специально подготовленный блок, длины ранее выбранных отрезков и ПЛ записываются в определенные атрибуты этого блока в виде полей.
Написал нижеприведенный LISP, но он на определенном этапе выдает ошибку "неверный тип аргумента". Не могу понять, в чем проблема. Просьба помочь. Чертеж с блоком прилагаю.

Код:
[Выделить все]
 (defun c:peredacha_L_transh_v_blok (/ n k_tr transhei podpis vla_podpis transh transh_ID imya_attr codpole)
  
  (vl-load-com)

  (setq n 0 k_tr 0)
  
  (setq transhei (ssget)); Выбор отрезков и полилиний траншей
  
  (setq k_tr (sslength transhei)); Количество выбранных траншей
     
  (if (> k_tr 7)
    (progn
     (princ "Количество траншей не должно быть больше 7! Откорректируйте чертеж.")
     (princ)
    ) 
  ); конец if
  
  (setq podpis (car (entsel "Выберите блок КС_Подпись кабеля: "))); Получение блока для заполнения атрибутов

  (setq vla_podpis (vlax-ename->vla-object podpis)); Преобразование блока в vla-объект
    
  (if (and transhei vla_podpis); Проверка получения траншей и блока
        
    (repeat k_tr
      
      (setq transh (car (entget (ssname transhei n))))
      
      (setq transh (vlax-ename->vla-object (car (entget (ssname transhei n))))); Вычленение траншеи из набора и преобразование в VLA-объект. Ошибка!!!!!   
          
      (setq transh_ID (Get-ObjectID-x86-x64 transh)); Извлечение ID траншеи    

      (setq codpole (strcat "%<\\AcObjProp Object(%<\\_ObjId " transh_ID ">%).Length \f "%lu6">%")); Cборка кода поля
       
      ;(setq codpole 1)

      (setq n (1+ n)); Щелкнул счетчик
      
      (princ (rtos n))

      (setq imya_attr (strcat ("ДЛИНА_ТРАНШ" (itoa (fix(n)))))); Формирование имени нужного атрибута
      
      (if codpole
       (LM:vl-setattributevalue vla_podpis imya_attr codpole); Передача поля в соответствующий атрибут блока
      ) ; конец if
    ); конец repeat
    
    (progn 
     (princ "Некорректные данные.")
     (princ)
    )  
  ); конец if
  
  (vl-cmdf "_regen")
  
); конец функции


;;;---------------------------------------------------------------------------------------------------------------------
;;; Библиотечные функции
;;;---------------------------------------------------------------------------------------------------------------------


;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)



(defun Get-ObjectID-x86-x64 (obj / util)
  (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (if (= (type obj) 'VLA-OBJECT)
     (if (> (vl-string-search "x64" (getvar "platform")) 0)
       (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
       (rtos (vla-get-objectid obj) 2 0)
     )
  )
)

Вложения
Тип файла: dwg Для_форума.dwg (25.4 Кб, 8 просмотров)

Просмотров: 1123
 
Непрочитано 15.09.2021, 17:44
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 38,328


В настройках VLIDE поставь галочку в Debug - "Break on error". По крайней мере поймешь, в каком месте кода ошибка.
P.S. У тебя код будет выполняться даже если пользователь выберет 100500 отрезков, ты в курсе?

----- добавлено через ~4 мин. -----
Туда же - никакого контроля типа выбираемых объектов нет.

----- добавлено через ~31 мин. -----
Поскольку работать не хочу, вот тебе вариант на посмотреть
Код:
[Выделить все]
 (defun c:lenth-to-attr (/ adpc get-objectid-x86-x64 selset block count att_list val_list err sysvar)
  (defun get-objectid-x86-x64 (obj / util)
    (setq util (vla-get-utility (vla-get-activedocument (vlax-get-acad-object))))
    (if (= (type obj) 'ename)
      (setq obj (vlax-ename->vla-object obj))
    ) ;_ end of if
    (if (= (type obj) 'vla-object)
      (if (> (vl-string-search "x64" (getvar "platform")) 0)
        (vlax-invoke-method util "GetObjectIdString" obj :vlax-false)
        (rtos (vla-get-objectid obj) 2 0)
      ) ;_ end of if
    ) ;_ end of if
  ) ;_ end of defun
  (cond ((/= (type (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "*LINE"))))))))
             'pickset
         ) ;_ end of /=
         (princ "\nОшибка выбора. Выход")
        )
        ((> (sslength selset) 7) (princ "\nОбъектов не может быть больше 7. Выход."))
        ((or (/= (type
                   (setq block (vl-catch-all-apply (function (lambda () (ssget "_+.:S:L" '((0 . "INSERT") (66 . 1)))))))
                 ) ;_ end of type
                 'pickset
             ) ;_ end of /=
             (/= (strcase (vla-get-effectivename (setq block (vlax-ename->vla-object (ssname block 0)))))
                 "КС_ПОДПИСЬ КАБЕЛЯ_LISP"
             ) ;_ end of /=
         ) ;_ end of or
         (princ "\nНе выбран блок или имя не КС_ПОДПИСЬ КАБЕЛЯ_LISP")
        )
        (t
         (setq count    0
               val_list (mapcar (function (lambda (entity)
                                            (setq count (1+ count))
                                            (cons (strcat "ДЛИНА_ТРАНШ" (itoa count))
                                                  (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                                                          (get-objectid-x86-x64 entity)
                                                          ">%).Length \\f \"%lu6 \">%"
                                                  ) ;_ end of strcat
                                            ) ;_ end of list
                                          ) ;_ end of lambda
                                ) ;_ end of function
                                ((lambda (/ tab item)
                                   (repeat (setq tab  nil
                                                 item (sslength selset)
                                           ) ;_ end setq
                                     (setq tab (cons (ssname selset (setq item (1- item))) tab))
                                   ) ;_ end of repeat
                                 ) ;_ end of lambda
                                )
                        ) ;_ end of mapcar
         ) ;_ end of setq
         (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
         (if (vl-catch-all-error-p
               (setq err (vl-catch-all-apply
                           (function (lambda ()
                                       (foreach att (vlax-safearray->list (vlax-variant-value (vla-getattributes block)))
                                         (if (wcmatch (vla-get-tagstring att) "ДЛИНА_ТРАНШ#*")
                                           (vla-put-textstring
                                             att
                                             (cond ((cdr (assoc (vla-get-tagstring att) val_list)))
                                                   (t "")
                                             ) ;_ end of cond
                                           ) ;_ end of vla-put-TextString
                                         ) ;_ end of if
                                       ) ;_ end of vlax-for
                                     ) ;_ end of lambda
                           ) ;_ end of function
                         ) ;_ end of VL-CATCH-ALL-APPLY
               ) ;_ end of setq
             ) ;_ end of VL-CATCH-ALL-ERROR-P
           (princ (strcat "\nОшибка выполнения: " (vl-catch-all-error-message err)))
         ) ;_ end of if
         (setq sysvar (mapcar (function (lambda (item / temp)
                                          (setq temp (getvar (car item)))
                                          (setvar (car item) (cdr item))
                                          (cons (car item) temp)
                                        ) ;_ end of lambda
                              ) ;_ end of function
                              '(("fieldeval" . 31))
                      ) ;_ end of mapcar
         ) ;_ end of setq
         (vla-regen adoc acactiveviewport)
         (foreach item sysvar (setvar (car item) (cdr item)))
         (vla-endundomark adoc)
        )
  ) ;_ end of cond
  (princ)
) ;_ end of defun
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 16.09.2021, 07:58
#3
Сыч


 
Регистрация: 05.04.2011
Сообщений: 26


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
В настройках VLIDE поставь галочку в Debug - "Break on error". По крайней мере поймешь, в каком месте кода ошибка.
Поставил выдает сообщение об ошибке (картинку приложил), строку с ошибкой почему-то не выделяет, хотя должен судя по этой теме https://forum.dwg.ru/showthread.php?t=52847
Предполагаю, что косяк в этой строке
Код:
[Выделить все]
 (setq transh (vlax-ename->vla-object (car (entget (ssname transhei n)))))
Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
P.S. У тебя код будет выполняться даже если пользователь выберет 100500 отрезков, ты в курсе?
В курсе, пока не решал эту проблему.

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Туда же - никакого контроля типа выбираемых объектов нет.
Так и есть, такого контроля нет.

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
вот тебе вариант на посмотреть
За lisp спасибо, на досуге посмотрю, но хотелось бы понять, что не так в моем.
Нашел некоторые косяки у себя, вот откорректированный вариант

Код:
[Выделить все]
 (defun c:peredacha_L_transh_v_blok (/ n k_tr transhei podpis vla_podpis transh transh_ID imya_attr codpole)
  
  (vl-load-com)

  (setq n 0 k_tr 0)
  
  (setq transhei (ssget)); Выбор отрезков и полилиний траншей
  
  (setq k_tr (sslength transhei)); Количество выбранных траншей
     
  (if (> k_tr 7)
    (progn
     (princ "\nКоличество траншей не должно быть больше 7! Откорректируйте чертеж.")
     (princ)
    ) 
  ); конец if
  
  (setq podpis (car (entsel "Выберите блок КС_Подпись кабеля: "))); Получение блока для заполнения атрибутов

  (setq vla_podpis (vlax-ename->vla-object podpis)); Преобразование блока в vla-объект
    
  (if (and transhei vla_podpis); Проверка получения траншей и блока
        
    (repeat k_tr
                  
      (setq transh (vlax-ename->vla-object (car (entget (ssname transhei n))))); Вычленение траншеи из набора и преобразование в VLA-объект. Ошибка!!!!!   
          
      (setq transh_ID (Get-ObjectID-x86-x64 transh)); Извлечение ID траншеи    

      (setq codpole (strcat "%<\\AcObjProp Object(%<\\_ObjId " transh_ID ">%).Length \f "%lu6">%")); Cборка кода поля
            
      (setq n (1+ n)); Щелкнул счетчик
      
      ;(princ (itoa n))

      (setq imya_attr (strcat "ДЛИНА_ТРАНШ" (itoa n))); Формирование имени нужного атрибута
      
      (if codpole
       (LM:vl-setattributevalue vla_podpis imya_attr codpole); Передача поля в соответствующий атрибут блока
      ) ; конец if
    ); конец repeat
    
    (progn 
     (princ "\nНекорректные данные.")
     (princ)
    )  
  ); конец if
  
  (vl-cmdf "_regen")
  
); конец функции


;;;---------------------------------------------------------------------------------------------------------------------
;;; Библиотечные функции
;;;---------------------------------------------------------------------------------------------------------------------


;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)



(defun Get-ObjectID-x86-x64 (obj / util)
  (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (if (= (type obj) 'VLA-OBJECT)
     (if (> (vl-string-search "x64" (getvar "platform")) 0)
       (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
       (rtos (vla-get-objectid obj) 2 0)
     )
  )
)
Миниатюры
Нажмите на изображение для увеличения
Название: Ошибка.jpg
Просмотров: 7
Размер:	10.8 Кб
ID:	240709  
Сыч вне форума  
 
Непрочитано 16.09.2021, 08:02
#4
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 38,328


1. Добавь в ssget фильтр хотя бы на тип примитива.
2. Проверяй тип podpis - блок ли это вообще и есть ли у него атрибуты.
3. transh должен быть ename, а у тебя черт-те что.
4. Ставишь галку, загружаешь код из VLIDE и стартуешь команду. Вот тогда должно остановиться. Как альтернатива - ставить точку останова и выполнять пошагово.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 16.09.2021, 09:39
#5
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,268


1. строка 26
Код:
[Выделить все]
 (setq transh (vlax-ename->vla-object (car (entget (ssname transhei n)))))
не имеет смысла, д.б.
Код:
[Выделить все]
 (setq transh (vlax-ename->vla-object (ssname transhei n)))
koMon вне форума  
 
Автор темы   Непрочитано 16.09.2021, 10:06
#6
Сыч


 
Регистрация: 05.04.2011
Сообщений: 26


Цитата:
Сообщение от koMon Посмотреть сообщение
не имеет смысла, д.б.
Спасибо. Всё заработало.

----- добавлено через ~8 мин. -----
Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
4. Ставишь галку, загружаешь код из VLIDE и стартуешь команду. Вот тогда должно остановиться. Как альтернатива - ставить точку останова и выполнять пошагово.
Спасибо. Подсветились косяки.

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
1. Добавь в ssget фильтр хотя бы на тип примитива.
Если хочу ограничить ввод отрезками и полилиниями такая строчка должна быть?
Код:
[Выделить все]
 (ssget '((-4 . "<OR") (0 . "LINE") (0 . "PLINE") (-4 . "OR>")))

Последний раз редактировалось Сыч, 16.09.2021 в 10:29.
Сыч вне форума  
 
Непрочитано 16.09.2021, 10:19
#7
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 38,328


Мой код, строка 14.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 16.09.2021, 10:23
#8
Сыч


 
Регистрация: 05.04.2011
Сообщений: 26


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Мой код, строка 14.
По твоему коду будут выбираться в том числе мультилинии и сплайны, если я правильно понял. А надо только отрезки и полилинии.
Сыч вне форума  
 
Непрочитано 16.09.2021, 10:33
#9
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,268


Код:
[Выделить все]
 (ssget '((0 . "LINE,LWPOLYLINE")))
koMon вне форума  
 
Автор темы   Непрочитано 16.09.2021, 20:13
#10
Сыч


 
Регистрация: 05.04.2011
Сообщений: 26


Итого
Код:
[Выделить все]
 (defun c:peredacha_L_transh_v_blok (/ n k_tr transhei podpis vla_podpis transh transh_ID imya_attr codpole)
  
  (vl-load-com)

  (setq transhei (ssget '((-4 . "<OR") (0 . "LINE") (0 . "*POLYLINE") (-4 . "OR>")))); Выбор отрезков и полилиний траншей

  (setq podpis (car (entsel "Выберите блок КС_Подпись кабеля_LISP: "))); Получение блока для заполнения атрибутов

  (princ "\n ")
    
  (setq n 0 k_tr 0)
     
  (if transhei (setq k_tr (sslength transhei))); Количество выбранных траншей

  (setq vla_podpis (vlax-ename->vla-object podpis)); Преобразование блока в vla-объект
  
 (cond
   
   ((= k_tr 0); Проверка выбора траншей
  
    (progn (princ "\nТраншеи не выбраны!") (princ))
   ); конец первой проверки

   ((> k_tr 10); Проверка количества выбранных траншей

    (progn (princ "\nКоличество выбранных траншей не должно быть больше 10! Откорректируйте чертеж.") (princ))
   ); конец второй проверки
   
   ((not(equal (cons 0 "INSERT") (assoc 0 (entget podpis))))
   
    (progn (princ "\nВыбранный для вставки объект не является блоком") (princ))
   ); конец третьей проверки
   
   ((/= (vla-get-effectivename vla_podpis) "КС_Подпись кабеля_LISP"); Проверка выбора нужного блока
    
    (progn (princ "\nВыбран неверный блок для вставки.") (princ))
   ); конец четвертой проверки
    
   ((and transhei vla_podpis); Проверка получения траншей и блока
        
    (progn
      (repeat k_tr
                  
       (setq transh (vlax-ename->vla-object (ssname transhei n))); Вычленение траншеи из набора и преобразование в VLA-объект.
      
       (setq transh_ID (Get-ObjectID-x86-x64 transh)); Извлечение ID траншеи  

       (setq codpole (strcat "%<\\AcObjProp Object(%<\\_ObjId " transh_ID ">%).Length \\f \"%lu6 \">%")); Cборка кода поля
            
       (setq n (1+ n)); Щелкнул счетчик

       (setq imya_attr (strcat "ДЛИНА_ТРАНШ" (itoa n))); Формирование имени нужного атрибута
      
       (if codpole
        (LM:vl-setattributevalue vla_podpis imya_attr codpole); Передача поля в соответствующий атрибут блока
       ) ; конец if
      ); конец repeat
     
      (repeat 3 (vl-cmdf "_regen") )

      (princ)
     ); конец progn
   ); конец пятой проверки
      
  ); конец cond
  
); конец функции


;;;---------------------------------------------------------------------------------------------------------------------
;;; Библиотечные функции
;;;---------------------------------------------------------------------------------------------------------------------


;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)



(defun Get-ObjectID-x86-x64 (obj / util)
  (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (if (= (type obj) 'VLA-OBJECT)
     (if (> (vl-string-search "x64" (getvar "platform")) 0)
       (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
       (rtos (vla-get-objectid obj) 2 0)
     )
  )
)
Сыч вне форума  
 
Непрочитано 16.09.2021, 21:05
#11
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 38,328


Вопрос - что получится, если выбрано будет 3 объекта?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 17.09.2021, 04:02
#12
Сыч


 
Регистрация: 05.04.2011
Сообщений: 26


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Вопрос - что получится, если выбрано будет 3 объекта?
Не понял вопроса. Про какие 3 объекта идет речь?
Если речь про то, что в блоке было 7 заполняемых атрибутов, а в lisp сейчас ограничение 10, то я блок уже отредактировал, увеличив количество атрибутов до 10.

Последний раз редактировалось Сыч, 17.09.2021 в 05:26.
Сыч вне форума  
 
Непрочитано 17.09.2021, 07:51
#13
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 38,328


Нет. Был обработан блок, в него загнали (в примеру) 10 объектов. Потом на тот же блок - но пробуют загнать уже 5 (!!) объектов. Что будет происходить с остальными 5 полями? Они же не удалятся, не обнулятся - ничего с ними не будет. И указывать они будут на непонятные какие-то объекты.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 17.09.2021, 09:01
#14
Сыч


 
Регистрация: 05.04.2011
Сообщений: 26


Вот тоже была такая мысль. Пока выпустил lisp в таком виде, оставив контроль этого момента за пользователем. Чуток попозже допилю этот момент.

----- добавлено через ~50 мин. -----
Добавил предварительное обнуление атрибутов
Код:
[Выделить все]
 (defun c:peredacha_L_transh_v_blok (/ n m k_tr transhei podpis vla_podpis transh transh_ID imya_attr codpole)
  
  (vl-load-com)

  (setq transhei (ssget '((-4 . "<OR") (0 . "LINE") (0 . "*POLYLINE") (-4 . "OR>")))); Выбор отрезков и полилиний траншей

  (setq podpis (car (entsel "Выберите блок КС_Подпись кабеля_LISP: "))); Получение блока для заполнения атрибутов

  (princ "\n ")
    
  (setq n 0 m 0 k_tr 0)
     
  (if transhei (setq k_tr (sslength transhei))); Количество выбранных траншей

  (setq vla_podpis (vlax-ename->vla-object podpis)); Преобразование блока в vla-объект
  
 (cond
   
   ((= k_tr 0); Проверка выбора траншей
  
    (progn (princ "\nТраншеи не выбраны!") (princ))
   ); конец первой проверки

   ((> k_tr 10); Проверка количества выбранных траншей

    (progn (princ "\nКоличество выбранных траншей не должно быть больше 10! Откорректируйте чертеж.") (princ))
   ); конец второй проверки
   
   ((not(equal (cons 0 "INSERT") (assoc 0 (entget podpis))))
   
    (progn (princ "\nВыбранный для вставки объект не является блоком") (princ))
   ); конец третьей проверки
   
   ((/= (vla-get-effectivename vla_podpis) "КС_Подпись кабеля_LISP"); Проверка выбора нужного блока
    
    (progn (princ "\nВыбран неверный блок для вставки.") (princ))
   ); конец четвертой проверки
    
   ((and transhei vla_podpis); Проверка получения траншей и блока
        
    (progn

      (repeat 10

       (setq m (1+ m)); Щелкнул счетчик

       (setq imya_attr (strcat "ДЛИНА_ТРАНШ" (itoa m))); Формирование имени нужного атрибута

       (LM:vl-setattributevalue vla_podpis imya_attr 0); Предварительное обнуление значения атрибута блока
	
      )
	
      (repeat k_tr
                  
       (setq transh (vlax-ename->vla-object (ssname transhei n))); Вычленение траншеи из набора и преобразование в VLA-объект.
      
       (setq transh_ID (Get-ObjectID-x86-x64 transh)); Извлечение ID траншеи  

       (setq codpole (strcat "%<\\AcObjProp Object(%<\\_ObjId " transh_ID ">%).Length \\f \"%lu6 \">%")); Cборка кода поля
            
       (setq n (1+ n)); Щелкнул счетчик

       (setq imya_attr (strcat "ДЛИНА_ТРАНШ" (itoa n))); Формирование имени нужного атрибута
      
       (if codpole
        (LM:vl-setattributevalue vla_podpis imya_attr codpole); Передача поля в соответствующий атрибут блока
       ) ; конец if
      ); конец repeat
     
      (repeat 3 (vl-cmdf "_regen") )

      (princ)
     ); конец progn
   ); конец пятой проверки
      
  ); конец cond
  
); конец функции


;;;---------------------------------------------------------------------------------------------------------------------
;;; Библиотечные функции
;;;---------------------------------------------------------------------------------------------------------------------


;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)



(defun Get-ObjectID-x86-x64 (obj / util)
  (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (if (= (type obj) 'VLA-OBJECT)
     (if (> (vl-string-search "x64" (getvar "platform")) 0)
       (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
       (rtos (vla-get-objectid obj) 2 0)
     )
  )
)

Последний раз редактировалось Сыч, 17.09.2021 в 09:53.
Сыч вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Проблема с передачей длины LINE в атрибуты блока

Система Техэксперт дает уверенность в правильности и эффективности принимаемых инженерных решений!
Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сбрасываются атрибуты блока при копировании valerik88 AutoCAD 14 13.05.2021 12:31
Autocad 2015 LT англ. - при внесении блока пропадают атрибуты istra AutoCAD 4 24.05.2016 09:52
Атрибуты блока не видны. shartal AutoCAD 6 02.01.2013 01:43
проблема: Смещение аттрибута блока при открытии файла на другой машине kakt00z AutoCAD 6 11.06.2009 23:12
Проблема с элементами нулевой длины в SCAD Nefilim SCAD 6 20.05.2009 09:01