Тема: Поделитесь простым нумератором...

Люди добрые поделитесь простой програмкой , набирающей последовательно циферки при клике мышкой: 1,  2,  3 ... и т.д. Заранее благодарен.

Re: Поделитесь простым нумератором...

Можно посмотреть здесь:
https://www.caduser.ru/forum/topic19907.html

Re: Поделитесь простым нумератором...

И здесь
http://project-ss.ucoz.ru/load/12-1-0-60

Re: Поделитесь простым нумератором...

Нумеровщик и перенумеровщик с префиксом и суффиксом:

(defun c:num (/ oldPref oldSuf oldStart curStr newNum
           actDoc actSp oldEcho oldSize *error*)
  (defun *error* (msg)
    (setvar "CMDECHO" oldEcho)
    (princ)
    ); end *error*
  (vl-load-com)
  (if(not num:Size)(setq num:Size(getvar "DIMTXT")))
  (if(not num:Pref)(setq num:Pref ""))
  (if(not num:Suf)(setq num:Suf ""))
  (if(not num:Num)(setq num:Num 1))
  (setq oldPref num:Pref
        oldSuf num:Suf
        oldStart num:Num
   oldSize num:Size
   actDoc(vla-get-ActiveDocument
      (vlax-get-acad-object))
   oldEcho(getvar "CMDECHO")
   ); end setq
  (setvar "CMDECHO" 0)
  (if(= (vla-get-ActiveSpace actDoc) 1)
    (setq actSp(vla-get-ModelSpace actDoc))
    (setq actSp(vla-get-PaperSpace actDoc))
    ); end setq
  (setq num:Size
    (getreal
      (strcat "\nSpecify text size <"(rtos num:Size)">: ")))
  (if(null num:Size)(setq num:Size oldSize))
  (setq num:Pref
    (getstring T
      (strcat "\nType prefix: <"num:Pref">: ")))
  (if(= "" num:Pref)(setq num:Pref oldPref))
  (if(= " " num:Pref)(setq num:Pref ""))
  (setq num:Suf
    (getstring T
      (strcat "\nType suffix: <"num:Suf">: ")))
  (if(= "" num:Suf)(setq num:Suf oldSuf))
  (if(= " " num:Suf)(setq num:Suf ""))
  (setq num:Num
    (getint
      (strcat "\nEnter start number <"(itoa num:Num)">: ")))
  (if(null num:Num)(setq num:Num oldStart))
(while T
  (setq curStr(strcat num:Pref(itoa num:Num)num:Suf)
        newNum(vla-AddText actSp
        curStr (vlax-3d-point
       '(0.0 0.0 0.0)) num:Size))
  (vla-put-Alignment newNum acAlignmentMiddleCenter)
  (command "_.copybase"(trans '(0.0 0.0 0.0)0 1)(entlast)"")
  (command "_.erase" (entlast) "")
  (command "_.pasteclip" pause)
    (setq num:Num(1+ num:Num))
  ); end while
  (princ)
  ); end of c:num
(defun c:renum (/ oldPref oldSuf oldStart curText curStr)
  (vl-load-com)
  (if(not rnm:Pref)(setq rnm:Pref ""))
  (if(not rnm:Suf)(setq rnm:Suf ""))
  (if(not rnm:Start)(setq rnm:Start 1))
  (setq oldPref rnm:Pref
        oldSuf rnm:Suf
        oldStart rnm:Start); end setq
  (setq rnm:Pref
    (getstring T
      (strcat "\nType prefix: <"rnm:Pref">: ")))
  (if(= "" rnm:Pref)(setq rnm:Pref oldPref))
  (if(= " " rnm:Pref)(setq rnm:Pref ""))
  (setq rnm:Suf
    (getstring T
      (strcat "\nType suffix: <"rnm:Suf">: ")))
  (if(= "" rnm:Suf)(setq rnm:Suf oldSuf))
  (if(= " " rnm:Suf)(setq rnm:Suf ""))
  (setq rnm:Start
    (getint
      (strcat "\nEnter start number <"
         (itoa rnm:Start)">: ")))
  (if(null rnm:Start)(setq rnm:Start oldStart))
(while T
  (setq curStr(strcat rnm:Pref(itoa rnm:Start)rnm:Suf))
    (setq curText
      (car
        (nentsel "\nSelect DText/MText/Attribute or Esc to Quit ")))
  (if
    (and
      curText
      (member(cdr(assoc 0(entget curText))) '("TEXT" "MTEXT" "ATTRIB"))
      ); end and
    (progn
    (vla-put-TextString
      (vlax-ename->vla-object curText)curStr)
    (setq rnm:Start(1+ rnm:Start))
    ); end progn
    (princ "\nThis is not DText or MText! ")
    ); end if
  ); end while
  (princ)
  ); end of c:renum

Re: Поделитесь простым нумератором...

> {Smirnoff}
Выход по Esc? А если в процессе нумерации надо пропустить число?

Re: Поделитесь простым нумератором...

> Владимир Громов
Выход по Esc? А если в процессе нумерации надо пропустить число?
Да выход по Esc. В данном случае думаю это оправдано.
Пропуск чисел правым кликом можно реализовать если вместо _.pasteclip использовать вставку в точку 0,0,0 (или другую) и _.move. При правом клике перемещаемый объект останется в точке 0,0,0. Это обстоятельство надо проверять и удалять оттуда "лишний" номер. Если у кого есть желание можно можно переработать, а мне пропускать номера не требуется.

Re: Поделитесь простым нумератором...

VVA пишет:

Гостям запрещено просматривать данную страницу, пожалуйста войдите на сайт как пользователь.

:(

Re: Поделитесь простым нумератором...

Совсем простой...
;; Вставка номеров по порядку от назначенного. Возможно переключение на режимы "Отступ"
;; (отступ от точки вставки вверх), "Линия" (подчеркивание текста), "Привязка" (Лево,
;; Право или Центр), автодобавление текста перед номером (ПРефикс) или после номера
;; (ПОстфикс). Смена режимов выполняется нажатием клавиш с заглавными буквами в названиях,
;; текущее состаяние отображается в квадратных скобках.

(vl-load-com)
(defun C:НОМЕР (/ OLDVAR *adoc* nom)
  (vlax-remove-cmd "")
  (foreach x
   '("cmdecho" "osnapcoord" "osmode" "apbox")
    (setq OLDVAR (cons (list x (getvar x)) OLDVAR))
  )
  (setq *adoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  (vla-StartUndoMark *adoc*)
  (setvar "cmdecho" 0)
  (setvar "osnapcoord" 1)
  (setvar "apbox" 0)
  ;; если нужно, добавить привязки "_nea,_end,_int,_per,"
  (foreach x '(512 1 32 128)
    (if (= 0 (logand x (getvar "osmode")))
      (setvar "osmode" (+ x (getvar "osmode")))
    )
  )
  ;; активизировать режим привязок
  (setvar "osmode" (logand -16385 (getvar "osmode")))
  (defun *maketxt* (TXT* PT* / dxfst ts)
    (setq dxfst (tblsearch "STYLE" (getvar "textstyle"))
          PT*   (trans PT* 1 0) ;; точка вставки в МСК
    )
    (if (zerop (setq ts (cdr (assoc 40 dxfst))))(setq ts (getvar "textsize")))
    (if REG_NOM (setq PT* (polar PT* (* pi 0.5)(* ts 0.22))))
    (if PREF (setq TXT* (strcat PREF TXT*)))
    (if POSTF (setq TXT* (strcat TXT* POSTF)))
    (if LIN_NOM (setq TXT* (strcat "%%U" TXT*)))
    (entmake ;; создать текстовый примитив
      (list
       '(0 . "TEXT")                     ;; тип примитива
        (cons 1 TXT*)                    ;; символы текста (строка)
        (cons 7 (getvar "textstyle"))    ;; текущий стиль
        (cons 10 PT*)                    ;; точка вставки
        (cons 11 PT*)                    ;; точка выравнивания
        (cons 40 ts)                     ;; высота
        (assoc 41 dxfst)                 ;; степень растяжения
        ;(cons 50 0)                      ;; угол поворота, рад.
        (cons 51 (cdr (assoc 50 dxfst))) ;; угол наклона
        (cons 72 JUST_NOM) ;; выравнивания (лев.0  цен.1  прав.2)
      ) ;;...list
    ) ;;...entmake
    (entlast)
  ) ;;...defun *maketxt*
  (princ "\n.\nU_Команда: НОМЕР")
  (defun *go* (/ key pt s)
    (while (not key)
      (mapcar (function princ) ;; информация в командной строке
        (list
          "\nОтступ'" (if REG_NOM "[да]" "[нет]")
          "   Линия'" (if LIN_NOM "[да]" "[нет]")
          "   Привязка'"
          (cond
            ((= 0 JUST_NOM) "[лев.]")
            ((= 2 JUST_NOM) "[прав.]")
            ((or (setq JUST_NOM 1)(= 1 JUST_NOM)) "[цен.]")
          )
          "   ПРефикс"
          (if (and (= (type PREF) 'STR)(read PREF))
            (strcat " \"" PREF "\"")
            (progn (setq PREF nil) "[нет]")
          )
          "   ПОстфикс"
          (if (and (= (type POSTF) 'STR)(read POSTF))
            (strcat " \"" POSTF "\"")
            (progn (setq POSTF nil) "[нет]")
          )
          "   НОМЕР <1>: "
        )
      ) ;;...mapcar
      (initget 128)
      (setq nom (getint)
        nom ;; опции...
          (cond
            ((not nom)(setq key T) "1") ;; по умолчанию номер 1
            ((= (type nom) 'INT)(setq key T)(itoa nom)) ;; ввод другого числа
            ((member (strcase nom) '("G" "П"))
              (cond
                ((= 1 JUST_NOM)(setq JUST_NOM 0)) ;; лев.
                ((= 0 JUST_NOM)(setq JUST_NOM 2)) ;; прав.
                (T (setq JUST_NOM 1))             ;; цен.
              )
            )
            ((member (strcase nom) '("J" "О"))
              (if REG_NOM (setq REG_NOM nil)(setq REG_NOM T))
            )
            ((member (strcase nom) '("K" "Л"))
              (if LIN_NOM (setq LIN_NOM nil)(setq LIN_NOM T))
            )
            ((member (strcase nom) '("GH" "HG" "ПР" "РП"))
              (princ "\n.\nПрефикс <нет>: ")
              (setq PREF (getstring T))
            )
            ((member (strcase nom) '("GJ" "JG" "ПО" "ОП"))
              (princ "\n.\nПостфикс <нет>: ")
              (setq POSTF (getstring T))
            )
            (T (setq key T) nil) ;; ввод недопустимого значения
          ) ;;...cond
      ) ;;...setq nom
      (princ "\n.")
    ) ;;...while not
    (if nom
      (progn
        (setq s (*maketxt* nom (setq pt (cadr (grread T 12)))))
        (princ
          (strcat
            "\nТочка вставки \""
            (vla-get-Textstring (vlax-ename->vla-object s))
            "\" : "
          )
        )
        (while (equal pt (cadr (grread T 12))))
      )
    ) ;;...if nom
    (while s ;; цикл мультивставки текста с номером
      (redraw s 2)
      (vl-cmdf "_.MOVE" s "" pt pause)
      (if (equal pt (getvar "lastpoint"))
        (progn (entdel s)(setq s nil))
        (progn
          (vla-EndUndoMark *adoc*)
          (vla-StartUndoMark *adoc*)
          (setq nom (itoa (1+ (read nom)))
                pt  (getvar "lastpoint")
                s   (*maketxt* nom pt)
          )
          (princ
            (strcat
              "\nТочка вставки \""
              (vla-get-Textstring (vlax-ename->vla-object s))
              "\" : "
            )
          )
        ) ;;...progn
      ) ;;...if equal
    ) ;;...while s
  ) ;;...defun *go*
  ;; отследить сбой
  (if (vl-catch-all-error-p (vl-catch-all-apply (function *go*)))(setq nom T))
  (vla-EndUndoMark *adoc*)
  (foreach x OLDVAR (setvar (car x)(cadr x)))
  (if (not nom)(alert "Допустим ввод заявленных опций\nили целых числовых значений !"))
  (princ)
)

Re: Поделитесь простым нумератором...

> {Smirnoff}
С "нумерацией" все в порядке. А вот как с "перенумерацией" я что- то не понял.

Re: Поделитесь простым нумератором...

> BigScrew
Ну "перенумерация" это не совсем корректный термин. Правильно наверное замена сушествующего DTEXT, MTEXT или ATTRIBUTE на номера.

Re: Поделитесь простым нумератором...

> {Smirnoff}
Я это понял...Но как это сделать? У меня чего не получилось. Сверху текст генерируемый программой накладывается на старый...

Re: Поделитесь простым нумератором...

> BigScrew
Я это понял...Но как это сделать? У меня чего не получилось. Сверху текст генерируемый программой накладывается на старый...

Теперь я ничего не понял.(? Как накладываетя? Программа нумерации вызывается NUM а "перенумерации" RENUM.

Re: Поделитесь простым нумератором...

> {Smirnoff}
Вот! Теперь понял, что для перенумерации нужно использовать другую команду....Ясно...Спасибо.
-------------------------------------------------------------------
p.s. И огромнейшее спасибо Вам за программу с сортировкой. Каждый день эта программа меня выручает.

Re: Поделитесь простым нумератором...

а как сделать,чтоб в суффиксе у меня писалась степень ( вторая, первая, двадцать третья)?

Re: Поделитесь простым нумератором...

а как при нумерации использовать суффикс в виде степени ( в кубе, квадрате, в двадцать второй надо еще бывает)?

Re: Поделитесь простым нумератором...

Ответ на мой вопрос появился тут, если что вдруг: https://www.caduser.ru/forum/topic33485.html