[BAMBR]

Привет всем! С наступающим всех!

Господа, помогите пожалуйста.
Может есть у кого-нибудь lisp который считает сумму отрезков которые я последовательно обозначил левой кнопкой мыши. Что то вроде усовершенствованного _dist.

А может вообще есть такая команда?

Заранее спасибо.

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

http://dwg.ru/forum/viewtopic.php?t=3724

[BAMBR]

Мне не надо сумму отрезков. Мне нужно чтобы я просто в пространстве листа тыкал на экран. И чтобы считалась сумма отрезков образовываемых между точками (тычками на экран ) :? .
Сам я не умею писать lisp, да и вобщем то за автокад пересел 2 месяца назад. Так что совсем не опытен. Но научился пользоваться этими lisp-ами.

[_Andre_]

Для пользователей написал вот такую програмку

Код:

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

(defun ba-get-dist-between-points (/ tek_len point1 point2 summ *error*)
  (defun *error* (msg /)
;;;    (command)
    (command "_.redrawall")
    (setvar "cmdecho" 1)
    (if	(and tek_len summ)
      (princ (strcat "\nДлина участка "
		     (rtos tek_len 2 1)
		     " Общая длина "
		     (rtos summ 2 1)
	     ) ;_ end strcat
      ) ;_ end princ
    ) ;_ end if
  ) ;_ end defun
  (vl-load-com)
  (setq summ 0)
  (setvar "cmdecho" 0)
  (if (setq point1 (getpoint "\nВведите первую точку"))
    (while (setq point2 (getpoint "\nВведите следующую точку" point1)) ;_ end setq
      (grdraw point1 point2 210)
      (setq tek_len (distance point1 point2)
	    summ    (+ summ tek_len)
      ) ;_ end setq
      (princ (strcat "\nДлина участка "
		     (rtos tek_len 2 1)
		     " Общая длина "
		     (rtos summ 2 1)
	     ) ;_ end strcat
      ) ;_ end princ
      (setq point1 point2)
    ) ;_ end while
  ) ;_ end if
  (if (and tek_len summ)
    (princ (strcat "\nДлина участка "
		   (rtos tek_len 2 1)
		   " Общая длина "
		   (rtos summ 2 1)
	   ) ;_ end strcat
    ) ;_ end princ
  ) ;_ end if
  (command "_.redrawall")
  (setvar "cmdecho" 1)
  (princ)
)

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

[_Andre_]

... и для удобства - указываемыми точки соединяются временными отрезками, которые исчезают после окончания работы программы или любом другом обновлении экрана

[BAMBR]

Спасибо! Ща попробую

очень оперативно

[BAMBR]

Andre, ты можешь еще рассказать как ей пользоваться? Я че то не разберусь

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

> BAMBR : Если хочешь пользовать прогу _Andre_, то с ком.строки (после загрузки лиспа) дай команду

Код:

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

(ba-get-dist-between-points)

Или вот вариант, то же самое, но с небольшими дополнениями:

Код:

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

(defun c:get-dist (/ end_point last_point sum_len)
  (setq sum_len 0)
  (if (not last_point)
    (setq last_point (getpoint "\nУкажите точку <Отмена> : "))
    ) ;_ end of if
  (while last_point
    (if (setq end_point
               (getpoint last_point "\nУкажите следующую точку <Отмена> : ")
              ) ;_ end of setq
      (progn
        (princ
          (strcat "\nТекущая длина : " (rtos (distance last_point end_point) 2))
          ) ;_ end of princ
        (setq sum_len    (+ sum_len (distance last_point end_point))
              last_point end_point
              ) ;_ end of setq
        (princ (strcat "\nОбщая длина : " (rtos sum_len 2)))
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of while
  ) ;_ end of defun

Вызов с ком.строки get-dist

[BAMBR]

Огромное спасибо всем что уделили время.
Реально помогли.
Еще раз всех с наступающим!

[VVA]

А не проще ли отрисовать по этим точкам полилинию и в свойствах посмотреть ее периметр?

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

А потом удалять объект...

[Dym]

С НАСТУПАЮЩИМ, ОДНАКО
BAMBR> не помню кто автор(найдётся - от меня отдельное СПАСИБО), но штучка замечательная:

(defun entLen (/ set:OfEnts int:l rea:LengthOfEnts)
(setq set:OfEnts (ssget)
int:l 0
rea:LengthOfEnts
0.0
) ;_ setq
(while (< int:l (sslength set:OfEnts))
(setq rea:LengthOfEnts
(+ rea:LengthOfEnts
(vlax-curve-getDistAtParam
(vlax-ename->vla-object (ssname set:OfEnts int:l))
(vlax-curve-getEndParam (ssname set:OfEnts int:l))
) ;_ vlax-curve-getDistAtParam
) ;_ +
) ;_ setq
(setq int:l (1+ int:l))
) ;_ while
(princ (strcat "\nПримитивов: - "
(itoa (sslength set:OfEnts))
"\nОбщая длина: - "
(rtos rea:LengthOfEnts)
) ;_ strcat
) ;_ princ
(prin1)
) ;_ defun

обкатанна и весьма радует