Autolisp. Допилить програмку по нумерации блоков

gizmo_zx · 09.11.2011, 16:49

Добрый день.
Есть программка нумерации блоков:

Код:

 

(defun c:xblocknum (/ testf name tag pref suff num ss el lstins ssd eld index) 
  (defun testf (a b / ea eb) 
    (setq ea (assoc 10 (entget a)) 
          eb (assoc 10 (entget b)) 
    ) 
    (or (> (caddr ea) (caddr eb)) 
        (and (= (caddr ea) (caddr eb)) (< (cadr ea) (cadr eb))) 
    ) 
  )
; ***  
;  (if (= (setq name0 (getstring "\nИмя блока:[Автомат1] ")) "") 
;    (setq name1 "Автомат1" 
;          pref  "" 
;          suff  "" 
;    ) 
;    (setq name1 name0 
;          pref  (getstring "\nПрефикс: ") 
;          suff  (getstring "\nСуффикс: ") 
;    ) 
;  ) 
;  (setq tag0 "num" 
;        name name1 
;        tag  (strcase tag0) 
;  )
; ***
(setq name0 (getstring "\nИмя блока:[Автомат1] "))
(if (= name0 "")(progn (setq name1 "Автомат1") (setq pref "")(setq suff "")(setq tag0 "num") )
			  (progn (setq name1 name0)(setq pref (getstring "\nПрефикс: ")) (setq suff (getstring "\nСуффикс: "))
				(setq name0 (getstring "\nИмя атрибута:[num] "))
				(if (= name0 "")(progn (setq tag0 "num"))(setq tag0 name0)) )
)
  (while (= (setq name name1) ""))
  (while (= (setq tag tag0) ""))
  (setq tag (strcase tag))

 
  (if (null (setq num (getint "\nСтартовый номер <1>: "))) 
    (setq num 1) 
  ) 
  (princ "\nБлоки > ") 
  (if (setq ss (ssget (list '(0 . "INSERT") '(410 . "Model") (cons 2 name)))) 
    (progn 
      (while (> (sslength ss) 0) 
        (setq ss (ssdel (setq el (ssname ss 0)) ss)) 
        (setq lstins (cons el lstins)) 
        (setq ssd 
               (ssget "_X" 
                      (list '(0 . "INSERT") '(410 . "Model") (cons 2 name) (assoc 10 (entget el))) 
               ) 
        ) 
        (if (> (sslength (ssdel el ssd)) 0) 
          (while (> (sslength ssd) 0) 
            (setq ssd (ssdel (setq eld (entdel (ssname ssd 0))) ssd)) 
            (ssdel eld ss) 
          ) 
        ) 
      ) 
      (setq index (vl-sort-i lstins 'testf)) 
      (while index 
        (setq el (nth (car index) lstins)) 
        (while (and (/= (cdr (assoc 0 (entget el))) "SEQEND") 
                    (/= (cdr (assoc 2 (entget el))) tag) 
               ) 
          (setq el (entnext el)) 
        ) 
        (if (= (cdr (assoc 2 (entget el))) tag) 
          (progn 
            (vla-put-textstring (vlax-ename->vla-object el) (strcat pref (rtos num 2 0) suff)) 
            (setq num (1+ num)) 
          ) 
        ) 
        (setq index (cdr index)) 
      ) 
    ) 
  ) 
  (princ) 
) 
(vl-load-com)

Что хотелось бы: Если имя блока для переименования отлично от Автомат1, то не забивать его в ручню, а выбрать "тыком".
Остальное как есть...

в lispe не силен

TararykovDG · 09.11.2011, 18:09

gizmo_zx, добавь в код вот эту функцию

Код:

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

 
; Получить ссылку на указанный объект на чертеже (1)
;	message - текст сообщения при запросе указать объект 
;	filter - список типов объктов для фильтрации (например: ("LINE" "INSERT") - значит будут восприниматься только объекты типа "LINE"  и "INSERT")
;	lock_enter - блокировка нажатия Enter (lock_enter - T при нажатии Enter будет снова запрос на указание объекта; lock_enter - nil выход из функции)
;	return - ссылка на указанный объект (например: <Имя объекта: 7e8ac738>) или 0 если нажали Enter при lock_enter - nil или 1 если нажали Esc
(defun _tdg-get-object-byselect(message filter lock_enter / return)
  ((lambda(errnovar)
     (setvar "errno" 0)
     (while (not (setq return ((lambda(obj)
                                 (if (not (vl-catch-all-error-p obj))
                                   (if obj
                                     (if filter
                                       (if (member (strcase (cdr (assoc 0 (entget (car obj))))) (mapcar 'strcase filter))
                                         (car obj)
                                         )
                                       (car obj)
                                       )
                                     (if (and (not lock_enter) (= (getvar "errno") 52))
                                       0
                                       )
                                     )
                                   1
                                   )
                                 )
                                (vl-catch-all-apply 'entsel
                                                    (list (strcat "\n" message))
                                                    )
                                )
                       )
                 )
       )
     (setvar "errno" errnovar)
     return
     )
    (getvar 'errno)
    )
  ); end _tdg-get-object-byselect

и вместо строки 26

Код:

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

 
(setq name0 (getstring "\nИмя блока:[Автомат1] "))

напиши так

Код:

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

 
(if (= (type (setq ent (_tdg-get-object-byselect "Укажите вхождение блока или <Автомат1>: " (list "INSERT") nil)))
       'ENAME
       )
  (setq name0 (vla-get-EffectiveName (vlax-ename->vla-object ent)))
  (setq name0 "")
  )

Nike · 09.11.2011, 18:18

глянь еще это - http://dwg.ru/dnl/515
и это - http://dwg.ru/dnl/1929

gizmo_zx · 10.11.2011, 09:36

TararykovDG, Спасибо, то что надо!

Кулик Алексей aka kpblc · 10.11.2011, 10:28

Цитата:

Сообщение от TararykovDG

gizmo_zx, добавь в код вот эту функцию

Код:

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

 
; Получить ссылку на указанный объект на чертеже (1)
;	message - текст сообщения при запросе указать объект 
;	filter - список типов объктов для фильтрации (например: ("LINE" "INSERT") - значит будут восприниматься только объекты типа "LINE"  и "INSERT")
;	lock_enter - блокировка нажатия Enter (lock_enter - T при нажатии Enter будет снова запрос на указание объекта; lock_enter - nil выход из функции)
;	return - ссылка на указанный объект (например: <Имя объекта: 7e8ac738>) или 0 если нажали Enter при lock_enter - nil или 1 если нажали Esc
(defun _tdg-get-object-byselect(message filter lock_enter / return)
  ((lambda(errnovar)
     (setvar "errno" 0)
     (while (not (setq return ((lambda(obj)
                                 (if (not (vl-catch-all-error-p obj))
                                   (if obj
                                     (if filter
                                       (if (member (strcase (cdr (assoc 0 (entget (car obj))))) (mapcar 'strcase filter))
                                         (car obj)
                                         )
                                       (car obj)
                                       )
                                     (if (and (not lock_enter) (= (getvar "errno") 52))
                                       0
                                       )
                                     )
                                   1
                                   )
                                 )
                                (vl-catch-all-apply 'entsel
                                                    (list (strcat "\n" message))
                                                    )
                                )
                       )
                 )
       )
     (setvar "errno" errnovar)
     return
     )
    (getvar 'errno)
    )
  ); end _tdg-get-object-byselect

и вместо строки 26

Код:

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

 
(setq name0 (getstring "\nИмя блока:[Автомат1] "))

напиши так

Код:

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

 
(if (= (type (setq ent (_tdg-get-object-byselect "Укажите вхождение блока или <Автомат1>: " (list "INSERT") nil)))
       'ENAME
       )
  (setq name0 (vla-get-EffectiveName (vlax-ename->vla-object ent)))
  (setq name0 "")
  )

Можно значительно проще и гарантированнее:

Код:

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

 (defun fun_get-name-by-selset (/ ent)
  (if (and (= (type (setq ent (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (vlax-ename->vla-object (ssname (ssget "_+.:S:E:L" '((0 . "INSERT") (66 . 1))) 0))
                                    ) ;_ end of LAMBDA
                                  ) ;_ end of function
                                ) ;_ end of VL-CATCH-ALL-APPLY
                          ) ;_ end of setq
                    ) ;_ end of type
              'vla-object
              ) ;_ end of =
           (equal (vla-get-isxref
                    (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-name ent))
                    ) ;_ end of vla-get-IsXRef
                  :vlax-false
                  ) ;_ end of equal
           ) ;_ end of and
    (cond
      ((vlax-property-available-p ent 'effectivename) (vla-get-effectivename ent))
      ((vlax-property-available-p ent 'name) (vla-get-name ent))
      ) ;_ end of cond
    ) ;_ end of if
  ) ;_ end of defun

Можно также идти через entsel, например. Или здесь поменять стандартное приглашение. Но это уже "бантики" ИМХО.

TararykovDG · 10.11.2011, 11:37

Кулик Алексей aka kpblc, спасибо. Всегда для выбора одного объекта предпочитал использовать entsel, а не ssget, потому что для ssget надо дополнительно жать Enter и совсем забыл про параметр ":S" который допускает только один интерактивный выбор, что позволяет избавиться от нажатия Enter.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
LISP. Очистка рисунка от "пустых" блоков	Makswell	Готовые программы	15	26.10.2022 15:24
Извлечение значений атрибутов блоков AutoCAD Electrical с помощью AutoLisp	zaraki_kenpachi	LISP	16	19.02.2011 15:30
Тормозит команда расчленения набора блоков	batmax	Программирование	4	31.08.2010 17:37
Альтернатива нумерации атрибутов блоков	Maxxwell	Программирование	13	01.06.2010 17:13
Подсчет и сортировка блоков на текущем слое. Помогите отредактировать.	Kortes	Программирование	17	26.03.2010 18:46