[rublikdimas]

Добрый день. Я черчу провода на планах зданий. Провода черчу полилиниями. У меня есть специальный блок, с атрибутами, в нем я задаю имя провода. Блок параметрируемый, с помощью команд переместить и растянуть я создал стрелочку, которая я навожу на провод. Так вот собственно задача, после того как я взял стрелку и навел ее на провод и щелкнул, тем самым завершив перемещение стрелки, необходимо выполнить программу, которая бы узнавала длину полилинии и передавала выбранное значение в атрибут блока. Задача очень важная и нужная, думаю не только для электриков. После этого можно вывести в excel блоки с параметрами и не нужно мучаться, узнавать какая длина у какого провода, ведь уже все будет как на ладони.

[Кулик Алексей aka kpblc]

Есть в Download сумматор линий. И на форуме тема "суммировать по цвету / типу / слою" не так давно была.

[rublikdimas]

Сообщение от Кулик Алексей aka kpblc Есть в Download сумматор линий. И на форуме тема "суммировать по цвету / типу / слою" не так давно была.

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

[Profan]

Поменяй местами провод и стрелочку. Т. е., выбери сначала провод, потом ИЗ него выползет стрелочка. IMHO.

[rublikdimas]

Сообщение от Profan Поменяй местами провод и стрелочку. Т. е., выбери сначала провод, потом ИЗ него выползет стрелочка. IMHO.

Огромное спасибо, натолкнули на мысль.

[kp+]

Offtop:

Сообщение от rublikdimas необходимо выполнить программу, которая бы узнавала длину полилинии и передавала выбранное значение в атрибут блока... После этого можно вывести в excel блоки с параметрами и не нужно мучаться, узнавать какая длина у какого провода, ведь уже все будет как на ладони.

Вообще-то это запросто делается с помощью полей и извлечения данных напрямую из полилиний. Я понимаю, что в разделе "Программирование" дурной тон напоминать о стандартных возможностях, но такой вопрос был бы актуален в этом разделе в 2006-2007 г. или ранее, а сейчас все-таки 2016, и тех, кто работает в версиях до 2007, почти нет. Другое дело, если автор вынужден работать в древней версии или стандартных возможностей недостаточно - например, требуют слишком много кликов на операцию, но об этом неплохо бы упомянуть.

[rublikdimas]

Сообщение от kp+ Offtop: Вообще-то это запросто делается с помощью полей и извлечения данных напрямую из полилиний. Я понимаю, что в разделе "Программирование" дурной тон напоминать о стандартных возможностях, но такой вопрос был бы актуален в этом разделе в 2006-2007 г. или ранее, а сейчас все-таки 2016, и тех, кто работает в версиях до 2007, почти нет. Другое дело, если автор вынужден работать в древней версии или стандартных возможностей недостаточно - например, требуют слишком много кликов на операцию, но об этом неплохо бы упомянуть.

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

----- добавлено через ~4 ч. -----
Появилась одна идея, стрелка выноски (я использую динамический блок в качестве выноски) имеет определенные координаты, которые можно найти в свойствах объекта. Так вот, можно ли с помощью лиспа узнать, какие объекты (id объектов и их обозначения, блок полилиния или другое) находятся на данных координатам? Ведь можно запустить программу, которая будет перебирать точки стрелок, узнавать какие под ними лежат полилинии и записывать длины полилинии в блок который указывает на нее. Реально выполнить такую процедуру?

[Profan]

Можно, также, получив точку на полилинии, сочинить две точки (левая нижняя и правая верхняя) для секрамки функции (ssget). Вычесть и прибавить по паре мм к X и Y к координатам конца стрелки, которая воткнется в полилинию. Правда, в секрамку ssget попадет и сама стрелка, но можно отфильтровать полилинию по слою или еще по какому-либо параметру. IMHO.

[skkkk]

То, что сказал Profan, я когда-то переводил на "лиспский":

Код:

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

(setq ss (ssget "_C" (polar pt (/ pi 4) 0.01) (polar pt (/ (* 5 pi) 4) 0.01) (list (cons 0 "LWPOLYLINE"))))

Так мы получим набор объектов типа LWPOLYLINE, проходящих через квадрат с диагональю 0.02 единицы чертежа с центром в точке, обозначенной переменной pt, в которую мы предварительно должны загнать нужную точку блока (конец стрелки).
Если полилиния там гарантированно одна, то из набора извлечем ее так:

Код:

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

(ssname ss 0)

[VVA]

Сообщение от rublikdimas Так вот, можно ли с помощью лиспа узнать, какие объекты (id объектов и их обозначения, блок полилиния или другое) находятся на данных координатам? Ведь можно запустить программу, которая будет перебирать точки стрелок, узнавать какие под ними лежат полилинии и записывать длины полилинии в блок который указывает на нее. Реально выполнить такую процедуру?

Реально. Если приложишь блок будет еще реальнее

Код:

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

(defun get-lw-length-from-pt (pt / ss)
  ;;;Ф-ция возвращает лнину полилинии в переданной точке pt или nil-если ничего не обнаружено
  (vl-load-com)
  (if
    (setq ss (ssget "_C" (polar pt (/ pi 4) 0.01) (polar pt (/ (* 5 pi) 4) 0.01) (list (cons 0 "LWPOLYLINE"))))
    (vlax-curve-getDistAtParam (ssname ss 0)(vlax-curve-getEndParam (ssname ss 0)))
    )
  )
;;;Пример использования
(defun C:TEST ()
  (if (setq pt (getpoint "\nТочка: "))
    (progn
      (if (and
           (setq pt (osnap pt "_nea"))
           (setq len (get-lw-length-from-pt pt))
           )
        (alert (strcat "Длина полилинии " (rtos len 2 3)))
        (alert "Ничено не найдено")
        )
      )
    )
  )

Если полилиний в данной точке будет несколько, возьмется первая выбранная

[Сергей812]

Сообщение от rublikdimas Поля - это слишком долго. Если на чертеже 500 выносок, и их приходится зачастую перемешать и чтобы оптимизировать заполнение чертежа иногда приходится стрелочку выноски переносить с одного объекта на другой. В идеальном варианте, выноска должна брать свойства объекта на которые она указывает, но к сожалению пока ни кто не сказал как это сделать.

убили выноску. Вызвали свою команду рисования новой выноски, предварительно указав мышью - к какому кабелю она принадлежит (щелкнув по нему в нужном месте). Точка указания принадлежности выноски кабелю и есть начало выноски. Если в кабеле (или привязанной к нему БД) есть информация о номере кабеля - то сразу рисуется выноска с номером кабеля, иначе берется следующий номер и в кабель (или БД) вноситься идентификатор и номер кабеля. Команда рисования выноски реализовалась на JIG NET API, думаю - на лиспе тоже можно эквивалентное создать. В чертеже есть лишь стандартные полилинии и мультивыноски, правда, с расширенными данными.

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

[rublikdimas]

Сообщение от VVA Реально. Если приложишь блок будет еще реальнее Код: [Выделить все] (defun get-lw-length-from-pt (pt / ss) ;;;Ф-ция возвращает лнину полилинии в переданной точке pt или nil-если ничего не обнаружено (vl-load-com) (if (setq ss (ssget "_C" (polar pt (/ pi 4) 0.01) (polar pt (/ (* 5 pi) 4) 0.01) (list (cons 0 "LWPOLYLINE")))) (vlax-curve-getDistAtParam (ssname ss 0)(vlax-curve-getEndParam (ssname ss 0))) ) ) ;;;Пример использования (defun C:TEST () (if (setq pt (getpoint "\nТочка: ")) (progn (if (and (setq pt (osnap pt "_nea")) (setq len (get-lw-length-from-pt pt)) ) (alert (strcat "Длина полилинии " (rtos len 2 3))) (alert "Ничено не найдено") ) ) ) ) Если полилиний в данной точке будет несколько, возьмется первая выбранная

Прикладываю выноску. Таких выносок и полилиний на чертеже может до 500 штук.

[Сергей812]

А ваш код где? Это вообще то ветка по программированию, а не поиск исполнителей на халяву.

[rublikdimas]

Сообщение от Сергей812 А ваш код где? Это вообще то ветка по программированию, а не поиск исполнителей на халяву.

Пишу, и кстати у меня просили блок, а не код.

[kp+]

Offtop:

Сообщение от rublikdimas Пишу, и кстати у меня просили блок, а не код.

Выкладывать свой код, в котором что-то не получается - обычное дело в данном разделе, можно и не дожидаться просьбы

[VVA]

Тестируй

Код:

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

(defun get-lw-length-from-pt (pt / ss)
;;;Ф-ция возвращает длину полилинии в переданной точке pt или nil-если ничего не обнаружено
  (vl-load-com)
  (if
    (setq ss
           (ssget "_C"
                  (polar pt (/ pi 4) 0.01)
                  (polar pt (/ (* 5 pi) 4) 0.01)
                  (list (cons 0 "LWPOLYLINE") (cons 410 (getvar "CTAB")))
           ) ;_ end of ssget
    ) ;_ end of setq
     (vlax-curve-getdistatparam
       (ssname ss 0)
       (vlax-curve-getendparam (ssname ss 0))
     ) ;_ end of vlax-curve-getDistAtParam
  ) ;_ end of if
) ;_ end of defun
(defun dyn_block_list (bname)
;;; bname - имя блока
  (vl-remove-if-not
    '(lambda (b1)
       (eq (strcase (vla-get-effectivename b1)) (strcase bname))
     ) ;_ конец lambda
    (mapcar
      'vlax-ename->vla-object
      (mapcar
        'cadr
        (ssnamex
          (ssget "_X"
                 (list (cons 0 "INSERT")
                       (cons 2 (strcat bname ",`*U*"))
                       (cons 410 (getvar "CTAB"))
                 ) ;_ конец list
          ) ;_ конец ssget
        ) ;_ конец ssnamex
      ) ;_ конец mapcar
    ) ;_ конец mapcar
  ) ;_ конец vl-remove-if-not
) ;_ end of defun
(defun mip-conv-to-str (dat)
  (cond ((= (type dat) 'INT) (setq dat (itoa dat)))
        ((= (type dat) 'REAL) (setq dat (rtos dat 2 12)))
        ((null dat) (setq dat ""))
        (t (setq dat (vl-princ-to-string dat)))
  ) ;_ end of cond
) ;_ end of defun
(defun mip-block-setattr-bylist (block att_list / txt lst)
;;; Sets attribute values to block.
;;; block - Object [VLA-OBJECT or ENAME] Ename or Vla object of block
;;; att_list - Dotted pair list[list] ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...)
;;;                 Tag_Name - string
;;;                    Value - string
  (if (= (type block) 'ENAME)
    (setq block (vlax-ename->vla-object block))
  ) ;_ end of if
  (setq att_list (mapcar '(lambda (x)
                            (cons (strcase (mip-conv-to-str (car x)))
                                  (mip-conv-to-str (cdr x))
                            ) ;_ end of cons
                          ) ;_ end of lambda
                         att_list
                 ) ;_ end of mapcar
  ) ;_ end of setq
  (if (and block
           (vlax-write-enabled-p block)
           (not (vlax-erased-p block))
           (= (vla-get-objectname block) "AcDbBlockReference")
           (vlax-property-available-p block 'Hasattributes)
           (eq :vlax-true (vla-get-hasattributes block))
      ) ;_ end of and
    (mapcar
      (function
        (lambda (attrib / tmp)
          (if (setq tmp
                     (assoc (strcase (vla-get-tagstring attrib)) att_list)
              ) ;_ end of setq
            (progn (vla-put-textstring attrib (cdr tmp)) (cdr tmp))
          ) ;_ end of if
        ) ;_ end of lambda
      ) ;_ end of function
      (vlax-invoke block 'GetAttributes)
    ) ;_ end of mapcar
  ) ;_ end of if
) ;_ end of defun

;;;Пример использования
(defun C:TEST (/ bname tagname pt len)
  (vl-load-com)
  (setq bname   "ВЫНОСКА_ПРОВОДА" ;_имя блока
        tagname "ДЛИНА_ПРОВОДА" ;_имя тага атрибута
  ) ;_ end of setq
  (foreach blk (dyn_block_list bname)
    (if (and
          (vlax-write-enabled-p blk)
          (setq pt (vlax-safearray->list
                     (vlax-variant-value (vla-get-insertionpoint blk))
                   ) ;_ end of vlax-safearray->list
          ) ;_ end of setq
          (setq pt (osnap pt "_nea"))
          (setq len (get-lw-length-from-pt pt))
        ) ;_ end of and
      (mip-block-setattr-bylist
        blk
        (list (cons tagname (rtos len 2 3)))
      ) ;_ end of mip-block-setattr-bylist
    ) ;_ end of if
  ) ;_foreach
) ;_ end of defun

Пример блока см #12 выноска.dwg

[Profan]

А значение PICKBOX здесь не играет роли?

[rublikdimas]

Сообщение от VVA Тестируй Код: [Выделить все] (defun get-lw-length-from-pt (pt / ss) ;;;Ф-ция возвращает длину полилинии в переданной точке pt или nil-если ничего не обнаружено (vl-load-com) (if (setq ss (ssget "_C" (polar pt (/ pi 4) 0.01) (polar pt (/ (* 5 pi) 4) 0.01) (list (cons 0 "LWPOLYLINE") (cons 410 (getvar "CTAB"))) ) ;_ end of ssget ) ;_ end of setq (vlax-curve-getdistatparam (ssname ss 0) (vlax-curve-getendparam (ssname ss 0)) ) ;_ end of vlax-curve-getDistAtParam ) ;_ end of if ) ;_ end of defun (defun dyn_block_list (bname) ;;; bname - имя блока (vl-remove-if-not '(lambda (b1) (eq (strcase (vla-get-effectivename b1)) (strcase bname)) ) ;_ конец lambda (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat bname ",`*U*")) (cons 410 (getvar "CTAB")) ) ;_ конец list ) ;_ конец ssget ) ;_ конец ssnamex ) ;_ конец mapcar ) ;_ конец mapcar ) ;_ конец vl-remove-if-not ) ;_ end of defun (defun mip-conv-to-str (dat) (cond ((= (type dat) 'INT) (setq dat (itoa dat))) ((= (type dat) 'REAL) (setq dat (rtos dat 2 12))) ((null dat) (setq dat "")) (t (setq dat (vl-princ-to-string dat))) ) ;_ end of cond ) ;_ end of defun (defun mip-block-setattr-bylist (block att_list / txt lst) ;;; Sets attribute values to block. ;;; block - Object [VLA-OBJECT or ENAME] Ename or Vla object of block ;;; att_list - Dotted pair list[list] ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...) ;;; Tag_Name - string ;;; Value - string (if (= (type block) 'ENAME) (setq block (vlax-ename->vla-object block)) ) ;_ end of if (setq att_list (mapcar '(lambda (x) (cons (strcase (mip-conv-to-str (car x))) (mip-conv-to-str (cdr x)) ) ;_ end of cons ) ;_ end of lambda att_list ) ;_ end of mapcar ) ;_ end of setq (if (and block (vlax-write-enabled-p block) (not (vlax-erased-p block)) (= (vla-get-objectname block) "AcDbBlockReference") (vlax-property-available-p block 'Hasattributes) (eq :vlax-true (vla-get-hasattributes block)) ) ;_ end of and (mapcar (function (lambda (attrib / tmp) (if (setq tmp (assoc (strcase (vla-get-tagstring attrib)) att_list) ) ;_ end of setq (progn (vla-put-textstring attrib (cdr tmp)) (cdr tmp)) ) ;_ end of if ) ;_ end of lambda ) ;_ end of function (vlax-invoke block 'GetAttributes) ) ;_ end of mapcar ) ;_ end of if ) ;_ end of defun ;;;Пример использования (defun C:TEST (/ bname tagname pt len) (vl-load-com) (setq bname "ВЫНОСКА_ПРОВОДА" ;_имя блока tagname "ДЛИНА_ПРОВОДА" ;_имя тага атрибута ) ;_ end of setq (foreach blk (dyn_block_list bname) (if (and (vlax-write-enabled-p blk) (setq pt (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint blk)) ) ;_ end of vlax-safearray->list ) ;_ end of setq (setq pt (osnap pt "_nea")) (setq len (get-lw-length-from-pt pt)) ) ;_ end of and (mip-block-setattr-bylist blk (list (cons tagname (rtos len 2 3))) ) ;_ end of mip-block-setattr-bylist ) ;_ end of if ) ;_foreach ) ;_ end of defun Пример блока см #12 выноска.dwg

Спасибо, уже сам написал)

----- добавлено через ~1 мин. -----
Вот моя программка, вытягиваю не только длину отрезков, но и их цвет и слой. Все выноски должны находится на одном слое! - Vinoski

Код:

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

 (defun get-lw-length-from-pt (pt / ss)
  ;;;?-??? ?????????? ????? ????????? ? ?????????? ????? pt ??? nil-???? ?????? ?? ??????????
  (vl-load-com)
  (if
    (setq ss (ssget "_C" (polar pt (/ pi 4) 0.01) (polar pt (/ (* 5 pi) 4) 0.01) (list (cons 0 "LWPOLYLINE"))))
    (vlax-curve-getDistAtParam (ssname ss 0)(vlax-curve-getEndParam (ssname ss 0)))
    )
  )



(defun c:proba ()

  (setq set_block (ssget "_x" (list '(8 . "Vinoski"))))
  (setq n (sslength set_block))
  (setq i 0)

(while(> n 0)

  (setq name_obj (ssname set_block (- n 1)))
  
  (setq list_obj (entget name_obj))

  (setq point_block (cdr(assoc 10 list_obj)))


  
  (setq at1 (entnext name_obj))
  (setq at2 (entnext at1))
  (setq at3 (entnext at2))
  (setq at4 (entnext at3))
  (setq at5 (entnext at4))


   (if 
           (setq len (get-lw-length-from-pt point_block))
           
	(progn

	  
  	 (setq len (rtos (get-lw-length-from-pt point_block) 2 0)) 	 

	 (setq vla_at3 (vlax-ename->vla-object at3))

  	 (vla-put-textstring vla_at3 len)


	 (setq poly_name (ssget "_C" (polar point_block (/ pi 4) 0.01) (polar point_block (/ (* 5 pi) 4) 0.01) (list (cons 0 "LWPOLYLINE"))))

	 (setq layer (cdr(assoc 8 (entget (ssname poly_name 0)))))

	 (setq vla_at4 (vlax-ename->vla-object at4))
  
 	 (vla-put-textstring vla_at4 layer)

	 (setq cObj (vlax-ename->vla-object (ssname poly_name 0)))
  
         (setq color (vla-get-color cObj))

	 (setq vla_at5 (vlax-ename->vla-object at5))
  
 	 (vla-put-textstring vla_at5 color)

 	 )
(progn
  
(setq vla_at3 (vlax-ename->vla-object at3))
(vla-put-textstring vla_at3 "0")
     )
      )
  
  (setq i (+ i 1))
  (setq n (- n 1))
)

	(sssetfirst nil set_block)
  
)

[VVA]

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

Код:

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

...
;_1-й раз
(if (setq len (get-lw-length-from-pt point_block)) ;_1-й раз
(progn 
...
;_2-й раз
   (setq len (rtos (get-lw-length-from-pt point_block) 2 0))   ;_2-й раз
...
;_3-й раз
  (setq poly_name (ssget "_C" (polar point_block (/ pi 4) 0.01) (polar point_block (/ (* 5 pi) 4) 0.01) (list (cons 0 "LWPOLYLINE")))) ;_3-й раз
...

Можно модифицировать ф-цию get-lw-length-from-pt и возвращать имя примитива

Код:

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

(defun get-lw-from-pt (pt / ss)
;;;Ф-ция возвращает имя примитива (ename) полилинии в переданной точке pt или nil-если ничего не обнаружено
  (vl-load-com)
  (if
    (setq ss
           (ssget "_C"
                  (polar pt (/ pi 4) 0.01)
                  (polar pt (/ (* 5 pi) 4) 0.01)
                  (list (cons 0 "LWPOLYLINE") (cons 410 (getvar "CTAB")))
           ) ;_ end of ssget
    ) ;_ end of setq
     (ssname ss 0)
  ) ;_ end of if
) ;_ end of defun

Тогда

Код:

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

...
;_1-й раз
(if (setq poly_name (get-lw-from-pt  point_block)) ;_1-й раз
(progn 
...
;_2-го раза нет
   (setq len (rtos (vlax-curve-getdistatparam poly_name  (vlax-curve-getendparam poly_name )) 2 0))   ;_2-й раз
...
;_и 3-го раза нет
;_Нет необходимости  (setq poly_name (ssget "_C" (polar point_block (/ pi 4) 0.01) (polar point_block (/ (* 5 pi) 4) 0.01) (list (cons 0 "LWPOLYLINE")))) ;_3-й раз
...

PS писал на ходу без проверки, надеюсь со скобками не напортачил.

[rublikdimas]

День добрый, у меня возникла следующая проблема, при выполнение команды (setq ss (ssget "_C" (polar pt (/ pi 4) 0.01) (polar pt (/ (* 5 pi) 4) 0.01) (list (cons 0 "LWPOLYLINE")))), при близком рассмотрение полилинии, все происходит без проблем, данные о полилинии записываются в переменную. Если я колесиком отдаляю видовой экран то почему то в переменную при выполнении той же самой команды записываются данные о соседней полилинии. Значение точки pt не меняется! Точка pt указывает именно на нужную мне полилинию. Не понимаю, если у меня на экране при отдалении полилинии начинают сливаться визуально, то и автокад думает что они сливаются?

----- добавлено через ~17 мин. -----

Сообщение от rublikdimas День добрый, у меня возникла следующая проблема, при выполнение команды (setq ss (ssget "_C" (polar pt (/ pi 4) 0.01) (polar pt (/ (* 5 pi) 4) 0.01) (list (cons 0 "LWPOLYLINE")))), при близком рассмотрение полилинии, все происходит без проблем, данные о полилинии записываются в переменную. Если я колесиком отдаляю видовой экран то почему то в переменную при выполнении той же самой команды записываются данные о соседней полилинии. Значение точки pt не меняется! Точка pt указывает именно на нужную мне полилинию. Не понимаю, если у меня на экране при отдалении полилинии начинают сливаться визуально, то и автокад думает что они сливаются?

Победил с помощью команды (command "_.zoom" "_c" pt 200.), засунул ее перед выбором объектов секущей рамкой. Правда выполнение теперь раз в 20 стало медленнее, но мне вместо 10 секунд три минуты особой роли не играют.