• На форуме с 6 июня 2006г.
  • Сообщений: 194
  • Спасибо: 0

Тема: Счетчик, для всех примитивов.

В теме https://www.caduser.ru/forum/topic21894.html  господин {Smirnoff} придумал хорошую вещь, копировать-вставлять текст куда угодно (выноски, таблицы, МText, просто текст, размеры), а есть счетчики "нумераторы" например https://www.caduser.ru/forum/topic29902.html . Дык вот о чем я, хорошо было бы пользоваться нумератором как в программе  {Smirnoff}, всюду: в таблицах, выносках, Mtext и даже в размерах. Уважаемые программисты это возможно? (мне самому такое просто не по силам).
PS Может где то это уже исполнено просто я не нашел. Вроде хорошо смотрел ни че не увидел.

  • На форуме с 6 июня 2006г.
  • Сообщений: 194
  • Спасибо: 0

Re: Счетчик, для всех примитивов.

я наверное не правильно спросил ?, а то че то тихо так.
нужен Нумератор, он же счетчик, чтоб нумеровать ну хотябы текст в таблицах, хорошо бы если была возможность номеровать выноски.

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 0

Re: Счетчик, для всех примитивов.

> Михаил74
Выноски будут нумероваться если у них уже есть
аннотация, пустые выноски нет
Ячейки таблицы будут нумероваться обычным порядком

  (defun getcell(tbl pt / )
  (vla-hittest
     tbl
     (vlax-3d-point pt)
     (vlax-3d-point (getvar "VIEWDIR"))
     'irow 'icol
    )
  (list irow icol)
  )
  (defun enumleaders (init / anno oent pickent)
  (while (setq pickent (entsel "\nSelect leader only: \n"))
    (setq oent (vlax-ename->vla-object (car pickent)))
    (if (and (eq "AcDbLeader"
        (vla-get-ObjectName oent))
        (not (vl-catch-all-error-p
     (vl-catch-all-apply (function (lambda()
          (setq anno (vla-get-annotation oent))))))))
    (progn
    (vla-put-textstring anno (itoa init))
    (vla-update anno)
    (vla-update oent)
    (setq init (1+ init))
    )
    (progn
      (alert "Wrong object or leader w/o annotation\nExit program")
      (exit)
      (princ)
      )
    )
    )
    (princ)
    )
  (defun enumcells (util init / col input num oent pt row )
  (setq num init)
  (while
  (vl-catch-all-error-p
     (vl-catch-all-apply (function (lambda()
  (vla-getentity util 'oent 'varp "Select acad table: "))))))
  (if (not (eq "AcDbTable"
      (vla-get-ObjectName oent)) )
    (progn
      (alert "Wrong object selected\nExit program")(exit)(princ))
    (progn
    (while (setq pt (getpoint "\nPick a point inside the cell: \n"))
    (setq input (getcell oent pt))
    (setq row (car input)
      col (cadr input))
    (vla-settext oent row col (itoa num))
    (setq num (1+ num))
    (setq pt nil)
    )
    )
  )
  (princ)
  )
  (defun C:enm (/ adoc ans init osm util)
  (vl-load-com)
  (setq osm (getvar "osmode"))
  (setvar "osmode" 0)
  (setq    adoc (vla-get-activedocument (vlax-get-acad-object))
    acsp (vla-get-modelspace adoc)
    util (vla-get-utility adoc))
  (initget "Table Leader")
  (setq ans (getkword "\nChoose object type to numerate (Table/Leader) <T> "))
  (if (not ans)(setq ans "Table"))
  (setq init (getint "\nEnter initial number <1> : > "))
  (if (not init)(setq init 1))
  (if (eq "Table" ans)
       (enumcells util init)
       (enumleaders init))
  (setvar "osmode" osm)
  (princ)
  )
  (prompt "\n\t\t***  Type ENM to execute  ***\n")
  (princ)

~'J'~

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: Счетчик, для всех примитивов.

;;;Измененный код для перенумерации
;;;Реализация {Smirnoff}
;;;https://www.caduser.ru/forum/topic29902.html
;;;https://www.caduser.ru/forum/topic21894.html
;;;Редакция 23.10.2006 Владимир Азарко (VVA)
;;;https://www.caduser.ru/forum/topic30467.html
(defun c:renum (/ oldPref oldSuf oldStart curText curStr vlaObj keepText)
(vl-load-com)
(defun TTC_Paste(pasteStr keepText / nslLst vlaObj)
(if (setq nslLst(nentsel "\nPaste text <exit> >>"))
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. "))); end condition #4
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
(setq aDoc(vla-get-ActiveDocument(vlax-get-acad-object)))
(vla-StartUndoMark aDoc)
(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))
(initget "Yes No Да Нет _Yes No Yes No")
(setq keepText (not (= "No" (getkword "\nkeep contents of the text [Yes/No] <Yes>:"))))
(setq rnm:Start (1- rnm:Start))
(while (TTC_Paste (setq curStr(strcat rnm:Pref(itoa (setq rnm:Start(1+ rnm:Start)))rnm:Suf)) keepText))
(vla-EndUndoMark aDoc)(princ)); end of c:renum

Символ разделения номера от старого значения задается суффиксом.