[antiponf]

Здравствуйте. Я думаю этот лисп поможет многим проектировщикам. Суть следующая: запускаешь лисп, появляется сообщение "введите коэффициент запаса", вводишь число, появляется сообщение "укажите ячейку таблицы в пространстве листа", указываешь ячейку, появляется сообщение "выделите примитивы на модели", выделяешь примитивы (полилиния, отрезок) , нажимаешь ентер и сумма длин всех примитивов умноженная на коэффициент запаса попадает в ячейку, а программа готова к выделению новых отрезков (полилиний) и занесения их в ячейку ниже. Завершение лиспа по клавише ескейп или можно свою команд какую нить придумать.
Заранее благодарен за помощь.

[angel-fear]

http://forum.dwg.ru/showthread.php?t=57484

Гораздо более полезная весчь!

[antiponf]

Сообщение от angel-fear http://forum.dwg.ru/showthread.php?t=57484 Гораздо более полезная весчь!

Ага знаю. Благодарю за подсказку, но последние изменения еще не выложили, а в том виде в котором она сейчас пока не подходит

[Nike]

Как-то так:

Код:

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

 (defun C:ls (/ echo sen ent lay Nab len da)
  (setq echo (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (princ "\n Определение слоя по объекту.")
  (setq sen (entsel " Выберите нужный объект: "))
  (if sen
    (progn (setq ent (entget (car sen)))
           (setq lay (cdr (assoc 8 ent)))
           (setvar "CLAYER" lay)
           (setq Nab (ssget "_X" (list (cons 8 lay))))
           (setq len (sslength Nab))
           (sssetfirst nil Nab)a
           (sssetfirst Nab Nab)
           (princ "\n Слой: ")
           (princ lay)
           (princ "  Количество объектов = ")
           (princ len)
    ) ;_ end of progn
    (princ "\n Объект не выбран!")
  ) ; if sen
  (setvar "cmdecho" echo)
  (if (> Nab nil)
    (progn (setq Sum 0
                 i 0
           ) ;_ end of setq
           (repeat (sslength Nab)
             (setq Curve (vlax-ename->vla-object (ssname Nab i))
                   i     (1+ i)
                   Param (vl-catch-all-apply 'vlax-curve-getendparam (list Curve))
             ) ;_ end of setq
             (if (not (vl-catch-all-error-p Param))
               (setq Sum (+ Sum (vlax-curve-getdistatparam Curve Param)))
             ) ;_ end of if
           ) ;_ end of repeat
    ) ;_ end of progn
    (setq Sum 0)
  ) ;_ end of if
  (princ "\n")
  (setq index (getreal "Введите коэффициентом запаса (Enter = 1):"))
  (if (eq index nil)
    (setq index 1)
  ) ;_ end of if
  (setq Cable-Sum (rtos (* index Sum) 2 2))
  (princ (strcat "\n*** Кабелей: " (rtos (sslength Nab)) " Сумма длин: " Cable-Sum))
  (setq *TEXTSIZE* (getvar "TEXTSIZE"))
  (setvar "cmdecho" 0)
  (setq tstyle (getvar "TEXTSTYLE")) ;_Стиль текста Стиль должен существовать
 ;_ Создаем текст
  (if (= (cdr (assoc 40 (tblsearch "STYLE" tstyle))) 0.0)
    ;; нулевая высота текста
    (vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) *TEXTSIZE* 0 Cable-Sum)
    (vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) 0)
  ) ;_ end of if
  (setq txt (entlast))
 
  (princ "\n Укажите точку вставки текста или ячейку таблицы:")
  (vl-cmdf "_.copybase" (trans '(0 0 0) 0 1) txt "" "_.erase" txt "" "_.pasteclip" "_none" pause)
 ;_ В txt примитив текста в pt точка вставки  
  (setq txt (entlast)
        pt  (getvar "LASTPOINT")
  ) ;_ end of setq
  (or
    (and ;_Проверяем, попала ли точка в ячейку таблицы
      (setq tblobj nil
            tblset (ssget "_X" '((0 . "ACAD_TABLE")))
      ) ;_ end of setq
      (setq lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))))
      (mapcar '(lambda (x)
                 (or tblobj
                     (and
                       (= :vlax-true
                          (vla-hittest
                            x
                            (vlax-3d-point (trans pt 1 0))
                            (vlax-3d-point (trans (getvar "VIEWDIR") 1 0))
                            'row
                            'col
                          ) ;_ end of vla-HitTest
                       ) ;_ end of =
                       (setq tblobj x)
                     ) ;_ end of and
                 ) ;_ end of or
               ) ;_ end of lambda
              lst
      ) ;_ end of mapcar
      tblobj
      row
      col
      (or (vla-settext tblobj row col Cable-Sum) t)
      (entdel txt)
    ) ;_ end of and
    (and ;_Не попала, рисуем текст с полем
      (setq txt (vlax-ename->vla-object txt))
      (vlax-write-enabled-p txt)
      (vlax-property-available-p txt 'TextString)
      (vlax-put txt 'TextString Cable-Sum)
    ) ;_ end of and
  ) ;_ end of or
)
 

Придут гуры - подправят..

[antiponf]

Сообщение от Nike Как-то так: Придут гуры - подправят..

Не немножко не так.. У вас идет проверка по слою, и выделение всего на слое, а хотелось бы чтоб выделялось на слое не все, а чтоб я сам бы выделил, и значение чтобы заносилось именно в таблицу autocad, причем после занесения программа бы переходила к следующему подсчету линий для ячейки ниже, с тем же коэффициентом запаса.

[Nike]

такого нету

[gomer]

убрать _X

[antiponf]

Сообщение от gomer убрать _X

простите не понял

[gomer]

чтоб ssget выбирал не все объекты а только выбранные пользователем нужно убрать _Х из

Код:

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

 (setq Nab (ssget "_X" (list (cons 8 lay))))

вставка в таблицу - вообще мрак, если есть имя примитива (таблицы) то зачем выбирать все таблицы и проверять их??? Вообще лучше было бы распараллелить вставку в текст и вставку в таблицу
ну и апофигей всего апофеоза выбор на разных вкладках, это что скакать как газель туда сюда или вставлять вслепую?

[antiponf]

Сообщение от gomer чтоб ssget выбирал не все объекты а только выбранные пользователем нужно убрать _Х из Код: [Выделить все] (setq Nab (ssget "_X" (list (cons 8 lay)))) вставка в таблицу - вообще мрак, если есть имя примитива (таблицы) то зачем выбирать все таблицы и проверять их??? Вообще лучше было бы распараллелить вставку в текст и вставку в таблицу ну и апофигей всего апофеоза выбор на разных вкладках, это что скакать как газель туда сюда или вставлять вслепую?

как раз таки наоборот, чтоб не прыгать между моделью и листом лучше все эти значения вслепую просуммировать, и разместить в таблице. даже если был выбран не тот столбик, значения то никуда не денутся и их легко можно будет скопировать в нужный столбик.

[Nike]

Откуда программа будет знать, в какие листы ей надо прыгать?
Или у тебя лист один? Какой тогда смысл таблицу в лист вытаскивать?
Размести ее в модели и не надо будет никуда прыгать.

[antiponf]

Сообщение от Nike Откуда программа будет знать, в какие листы ей надо прыгать? Или у тебя лист один? Какой тогда смысл таблицу в лист вытаскивать? Размести ее в модели и не надо будет никуда прыгать.

Лист один. На модели все находится в масштабе один к одному, все что на листе отмасштабированно. С таблицей просто не удобно работать в пространстве модели

[Nike]

Чем не удобно? Заполни её в модели и перенеси потом в лист..

[antiponf]

Сообщение от Nike Чем не удобно? Заполни её в модели и перенеси потом в лист..

ок. если так легче сделать, то хотя бы так...

[Nike]

нее, я не говорил, что смогу это сделать..
Я про то, что эта прога достаточна для выполнения задачи.

Выбрал нужное - кликнул в ячейку, выбрал нужное - кликнул в ячейку и т.д..

[antiponf]

Сообщение от Nike нее, я не говорил, что смогу это сделать.. Я про то, что эта прога достаточна для выполнения задачи. Выбрал нужное - кликнул в ячейку, выбрал нужное - кликнул в ячейку и т.д..

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

[Nike]

ну тогда жди, может кто поможет.
А я на такое не способен, увы

[Frigate]

antiponf,

а что именно не хватает в программке по просчету плана трасс? Я собираю идеи, и если они многим окажутся полезными, попробую добавить в функционал проги.

[allar8]

Возможен ли вариант подсчета кол-ва примитивов (в частности полилиний ) с занесением результата не в ячейку таблицы а просто в текст или в поле, что еще лучше. Т.е значение поля как бы зависит от кол-ва первоначально выбранных объектов и если из это набора объектов удалить часть полилиний то значение поля автоматически или после обновления тоже изменится. К тому же хотелось бы чтоб значение данного поля тоже менялось в случае нового выбора объектов. Может что то подобное и в стандартных средствах или в Express есть - незнаю. Может кто уже задавался подобным вопросом?

[skkkk]

allar8, что-то похожее, кажется, было в теме Связь графических объектов и текста.

[allar8]

Сообщение от skkkk allar8, что-то похожее, кажется, было в теме Связь графических объектов и текста.

Судя по теме, на первый взгляд, там скорее всего речь идет лишь о свойствах одного объекта - с этим то проблем нет. Я конечно не все там посмотрел, но не могли бы подсказать номер поста именно по моему вопросу (Меня ведь интересует не отдельное свойство конкретного объекта, а колво конткретных объектов)

[skkkk]

allar8, проверил код из #35 (по ссылке) - работает корректно, правда там не поля, а реакторы, и для добавления в "сумму" и удаления из нее отдельных объектов используются отдельные команды, которые высвечиваются в командной строке при загрузке лиспа. И результат там вставляется в имеющийся текст, а не в создающийся новый.

Код из #56 - даже после добавления в него нужной версии (там прописано до 2008) - почему-то вываливает в fatal error. И судя по фрагменту

Код:

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

  ;_ Формируем поле
  (setq fld (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Length \\f \"%lu2%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALE*)"]\">%"
                ) ;_ strcat
          ) ;_ setq

действительно - речь идет об одном объекте.