Тема: Поделитесь простым нумератором...
Люди добрые поделитесь простой програмкой , набирающей последовательно циферки при клике мышкой: 1, 2, 3 ... и т.д. Заранее благодарен.
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → LISP → Поделитесь простым нумератором...
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Люди добрые поделитесь простой програмкой , набирающей последовательно циферки при клике мышкой: 1, 2, 3 ... и т.д. Заранее благодарен.
Можно посмотреть здесь:
https://www.caduser.ru/forum/topic19907.html
Нумеровщик и перенумеровщик с префиксом и суффиксом:
(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
> {Smirnoff}
Выход по Esc? А если в процессе нумерации надо пропустить число?
> Владимир Громов
Выход по Esc? А если в процессе нумерации надо пропустить число?
Да выход по Esc. В данном случае думаю это оправдано.
Пропуск чисел правым кликом можно реализовать если вместо _.pasteclip использовать вставку в точку 0,0,0 (или другую) и _.move. При правом клике перемещаемый объект останется в точке 0,0,0. Это обстоятельство надо проверять и удалять оттуда "лишний" номер. Если у кого есть желание можно можно переработать, а мне пропускать номера не требуется.
Гостям запрещено просматривать данную страницу, пожалуйста войдите на сайт как пользователь.
:(
Совсем простой...
;; Вставка номеров по порядку от назначенного. Возможно переключение на режимы "Отступ"
;; (отступ от точки вставки вверх), "Линия" (подчеркивание текста), "Привязка" (Лево,
;; Право или Центр), автодобавление текста перед номером (ПРефикс) или после номера
;; (ПОстфикс). Смена режимов выполняется нажатием клавиш с заглавными буквами в названиях,
;; текущее состаяние отображается в квадратных скобках.
(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) )
> {Smirnoff}
С "нумерацией" все в порядке. А вот как с "перенумерацией" я что- то не понял.
> BigScrew
Ну "перенумерация" это не совсем корректный термин. Правильно наверное замена сушествующего DTEXT, MTEXT или ATTRIBUTE на номера.
> {Smirnoff}
Я это понял...Но как это сделать? У меня чего не получилось. Сверху текст генерируемый программой накладывается на старый...
> BigScrew
Я это понял...Но как это сделать? У меня чего не получилось. Сверху текст генерируемый программой накладывается на старый...
Теперь я ничего не понял.(? Как накладываетя? Программа нумерации вызывается NUM а "перенумерации" RENUM.
> {Smirnoff}
Вот! Теперь понял, что для перенумерации нужно использовать другую команду....Ясно...Спасибо.
-------------------------------------------------------------------
p.s. И огромнейшее спасибо Вам за программу с сортировкой. Каждый день эта программа меня выручает.
а как сделать,чтоб в суффиксе у меня писалась степень ( вторая, первая, двадцать третья)?
а как при нумерации использовать суффикс в виде степени ( в кубе, квадрате, в двадцать второй надо еще бывает)?
Ответ на мой вопрос появился тут, если что вдруг: https://www.caduser.ru/forum/topic33485.html
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → LISP → Поделитесь простым нумератором...
Форум работает на PunBB, при поддержке Informer Technologies, Inc