Форум: "Потрепаться";
Текущий архив: 2005.02.27;
Скачать: [xml.tar.bz2];
ВнизКтонибуть в лиспе разбирается? (Встроеный макроязык АвтоКад) Найти похожие ветки
← →
syte_ser78 © (2005-02-04 11:01) [0]Есть код
(defun C:pickblocknum (/ name tag pref suff num ss el)
(while (= (setq name (getstring "\nИмя блока: ")) ""))
;;; (setq name (strcase name))
(while (= (setq tag (getstring "\nТег: ")) ""))
;;; (setq tag (strcase tag))
(setq pref (getstring "\nПрефикс: "))
(setq suff (getstring "\nСуффикс: "))
(if (null (setq num (getint "\nСтартовый номер: <1>")))
(setq num 1)
) ;_ if
(princ "\nУказывайте блоки в порядке их нумерации> ")
(if (setq ss (ssget (list "(0 . "INSERT") "(410 . "Model") (cons 2 name))))
(while (> (sslength ss) 0)
(setq ss (ssdel (setq el (ssname ss 0)) ss))
;; поиск нужного атрибута
(while (and (/= (cdr (assoc 0 (entget el))) "SEQEND")
(/= (cdr (assoc 2 (entget el))) tag)
) ;_ or
(setq el (entnext el))
) ;_ while
;; если атрибут найден
(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)) ;_ приращение номера
) ;_ progn
) ;_ if
) ;_ while
) ;_ if
(princ)
) ;_ defun
(vl-load-com)
Нужно его модернизировать чтобы он записывал в атрибуты блоков номера не с 1 а с максимального найденого в чертеже +1.
Блин, никак не могу в этот лисп въехать. наверное проще на Delphi написать будет.
← →
syte_ser78 © (2005-02-04 11:06) [1]Прошу прощения за промазывание с разделом. Предназначалось для "Потрепатся"
← →
TUser © (2005-02-04 14:23) [2]Я этого языка не знаю, но ИМХО, тут setq означает присвоение, а все выражения записаны в префиксной форме. Это значит, что приращение номера
(setq num (1+ num))
надо заменить на его уменьшение
(setq num (- 1+ num))
Кстати, непонятно - почему 1+num записан в инфиксной записи. Но про это надо книжки читать про сей язык. Непонятно также, почему надо увеличивать (уменьшать) номер только если аттрибут не найден - но это тебе лучше знать.
Также надо присвоить правильное начальное значение. Оно присваивается вот здесь
(if (null (setq num (getint "\nСтартовый номер: <1>")))
(setq num 1)
) ;_ if
соответственно меняем на
(if (null (setq num (getint "\nПоследний номер: ")))
( <а здесь какое-нибудь грозное сообщение и Exit> )
) ;_ if
Возможно и еще чего-нибудь надо поменять.
← →
Mike Kouzmine © (2005-02-04 17:58) [3]Найди максимальное, прибавь единицу.
Страницы: 1 вся ветка
Форум: "Потрепаться";
Текущий архив: 2005.02.27;
Скачать: [xml.tar.bz2];
Память: 0.45 MB
Время: 0.037 c