[gizmo_zx]

Lisp простой нумератор для Nanocad.
Добрый день.

Код:

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

 
; Получить ссылку на указанный объект на чертеже (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)
(princ "\n OK2 \n") 
  ((lambda(errnovar)
	(princ "\n OK3 \n") 
     (setvar "errno" 0)
     (while (not (setq return ((lambda(obj)
	(princ "\n OK4 \n") 
                                 (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


(defun c:xblocknum (/ testf name tag pref suff num ss el lstins ssd eld index) 
(princ "\n OK1 \n") 
  (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 (= (type (setq ent (_tdg-get-object-byselect "Укажите вхождение блока или <Автомат1>: " (list "INSERT") nil)))
       'ENAME
       )
  (setq name0 (vla-get-EffectiveName (vlax-ename->vla-object ent)))
  (setq name0 "")
  )


(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)

Результать в nanocade 5.1: (в Autocad все ок)

Код:

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

 OK1 

 OK2 
не определено sysvar: ERRNO
ошибка: variable setting rejected: "errno" 
 OK3 
0

Я так понял проблемма с определением (присвоением) номера ошибки (я так понял проблемма в функции _tdg-get-object-byselect).

Сам-то я lisp совсем плохо ...

Бодсобите светлые головы dwg...

[swell{d}]

рабочий код

[gomer]

обратитесь к TararykovDG, это его код