[pion]

Добрый день!

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

Возможно ли как-то в меню CUI прописать команду measuregeom и сделать, чтобы результат ее измерения копировался в буфер обмена автоматически или после нажатия клавиши Enter ?

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

http://dwg.ru/cse/?cx=partner-pub-19...833j2298789j42

[pion]

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


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

[Krieger]

Для дистанций, можно так:

Код:

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

;(kr_distance)
(defun kr_distance (/ p1 p2 dist *error*)
  (defun *error* (msg)
    (setq p1 nil dist nil p2 nil))
  (if (setq p1 (getpoint "\nНачало отрезка <выбрать отрезок или полилинию>"))
    
    (if (setq p2 (getpoint p1 "\nОкончание отрезка"))
      	(setq dist (distance p1 p2))
      );if
  
    (setq dist (vla-get-length (vlax-ename->vla-object (Kr_entsel "\nВыбери отрезок или полилинию" '("LINE" "LWPOLYLINE") nil))))
    );if

	(if dist (copyToclipboard (rtos dist  2 4)))
	(if dist (prompt (strcat "\nдлина: " (rtos dist 2 4))) (prompt (strcat "\nотмена")))
  (princ)
);defun

(defun Kr_entsel (promt filter entlist / key n newentlist ent_point promt)
  
  (setq key T n 0 newentlist nil)
  (if (eq (type entlist) 'PICKSET)
    (progn
    	(while (setq a (ssname entlist n)) (setq newentlist (append newentlist (list a)) n (1+ n)))
    	(setq entlist newentlist)
    );progn
   );if
    (while key
    	(if (or (setq ent_point (entsel promt)) (= (getvar "ERRNO") 7))
	  	(if (or (eq (type ent_point) 'LIST) (not ent_point))
		  (if ent_point
		    (if (member (setq ent (car ent_point)) entlist)
		      (princ "\nПримитив уже выбран")
		      (if filter
			      (if (not (member (cdr (assoc 0 (entget ent))) filter))
				(progn (setq str "\nНе верный выбор, выберите: ")
				  (princ (substr (setq str (foreach n filter (setq str (strcat str n ", ")))) 1 (- (strlen str) 2)))
				);progn
				(setq key nil)
			      );if
				(setq key nil)
			);if
		    );if
		    (setq key T)
		  );if
	    	(setq key nil)
	    );if
	  (setq key nil)
      	);if
     );while
  (if (eq (type ent_point) 'LIST)
    (progn (setvar "LASTPOINT" (cadr ent_point)) ent)
    ent_point
  );if
)

;  ! ***************************************************************************
;; !                           copyToclipboard
;; ! ***************************************************************************
;; ! Function : Copy text to clipboard
;; ! Argument : 'str'     - String
;; ! Returns  : nil
;; see http://www.theswamp.org/index.php?topic=21764.new
;; ! ****************************************************************************

(defun copyToclipboard ( text / htmlfile result)
 (setq result
        (vlax-invoke
            (vlax-get
                (vlax-get
                    (setq htmlfile (vlax-create-object "htmlfile"))
                   'ParentWindow
                )
               'ClipBoardData
            )
           'SetData
            "Text"
            text
        )
    )

    (vlax-release-object htmlfile)
    result
)

[pion]

Krieger,

Подскажите, это Lisp ? Т.е для его загрузки необходимо скопировать код, вставить в текстовый файл и сохранить с расширением LSP. Или данный код нужно загружать другим способом?

[Krieger]

Это лисп.
http://dwg.ru/pub/9

[pion]

Krieger,

Спасибо. Все работает. Возможно измерить длину только между двух точек или возможно измерять путь м/у нескольми точками?

[Krieger]

Ну вот если у тебя путь задан цельной полилинией, то выполнив мою функцию (kr_distance), при запросе первой точки, нажать enter и указать полилинию, тогда запомнится длина полилинии. Как вариант. А так на лиспе почти все что угодно можно сделать.

[pion]

Насколько сложно адаптировать код выше под то, чтобы он мог мерить путь м/у несколькими точками ? Возможно ли это сделать самостоятельно человеку, не знающему Lisp, изучив элементарные основы?

[Krieger]

Сообщение от pion Насколько сложно адаптировать код выше под то, чтобы он мог мерить путь м/у несколькими точками ?

Да не, не сложно.

Сообщение от pion Возможно ли это сделать самостоятельно человеку, не знающему Lisp, изучив элементарные основы?

Конечно.

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

Код:

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

;(kr_multidistance)
(defun kr_multidistance (/ p1 p2 dist *error* entlist)
  (defun *error* (msg)
    (setq p1 nil dist nil p2 nil)
    (foreach ent entlist (entdel ent))
    (setvar "CECOLOR" color)
    (setvar "CELWEIGHT" weight)
    (prompt (strcat "\nотмена"))
    )

  (setq dist 0.0
	entlist nil
	color (getvar "CECOLOR")
	weight (getvar "CELWEIGHT"))
  
  (if (setq p1 (getpoint "\nНачало первого сегмента <выход>"))
    (while (setq p2 (getpoint p1 "\nСледующая точка <закончить>"))
      (setvar "CECOLOR" "1")
      (setvar "CELWEIGHT" 40)
      
      (vl-cmdf "_line" p1 p2 "")
      (setq dist (+ (distance p1 p2) dist))
      (setq p1 p2)
      (setq entlist (append entlist (list (entlast))))
      )
    )
  	(foreach ent entlist (entdel ent))
        (setvar "CECOLOR" color)
      	(setvar "CELWEIGHT" weight)
	(if dist (copyToclipboard (rtos dist  2 4)))
	(if dist (prompt (strcat "\nдлина: " (rtos dist 2 4))) (prompt (strcat "\nотмена")))
  (princ)
);defun

;  ! ***************************************************************************
;; !                           copyToclipboard
;; ! ***************************************************************************
;; ! Function : Copy text to clipboard
;; ! Argument : 'str'     - String
;; ! Returns  : nil
;; see http://www.theswamp.org/index.php?topic=21764.new
;; ! ****************************************************************************

(defun copyToclipboard ( text / htmlfile result)
 (setq result
        (vlax-invoke
            (vlax-get
                (vlax-get
                    (setq htmlfile (vlax-create-object "htmlfile"))
                   'ParentWindow
                )
               'ClipBoardData
            )
           'SetData
            "Text"
            text
        )
    )

    (vlax-release-object htmlfile)
    result
)

[pion]

Krieger,

Спасибо, большое за помощь. Это то, что нужно.

Тему можно закрывать)