[elektrek]

Помогите пожалуйста с лиспом! необходимо измерить расстояния между двумя точками и затем результат - расстояние, чтобы можно было вывести на чертеже! Что то вроде параллельного размера, но должно выводится: -"расстояние""м"-. Т.е. это например: -100м-, и чтобы текст (-100м-) был залит белым фоном! Заранее спасибо!

[Alan]

Это что, злой препод издевается?
Чем его Команда: _DIST не устраивает?

[Do$]

Ну да, похоже, опять сессия у будущих (или потенциальных?) инженегров

[Nike]

Сообщение от Alan _DIST

Вот спасибо! 12 лет как в Автокаде "инженегр", а про такую команду и не знал!

[vl74]

Примечание - точность команды _DIST зависит от настроенной точности единиц чертежа.

[Jonas]

Создать стиль размера без линий и с заливкой текста.

[Krieger]

Для себя накидал вот такую простенькую прогу для замены стандартной команды DIST. В отличии от встроенной _dist, моя выводит длину не только между точками, но и длину отрезка или полилинии по желанию, плюс сохраняет результат в буфер обмена, откуда значение можно вставить в тот же текст на чертеже, калькулятор или exel... Правда не показывает dx, dy и dz, которые мне не нужны.

Может пригодится кому:

Код:

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

(defun c:di () (kr_distance))

;(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



;
;  ! ***************************************************************************
;; !                           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
)

[elektrek]

Jonas спасибо огромное, чет сам не додумался Зачет сдал

[perpetule]

di.lsp

(defun c:di () (kr_distance))

;(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



;
; ! ***************************************************************************
;; ! 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
)

;|Функция Kr_entsel
*** Автор Морозов С.В. aka Krieger ***
Еденичный выбор объекта, замена функции entsel
Возвращает entity name выбранного примитива или nil, точку указки запоминает в переменной LASTPOINT
Параметры:
promt - предложение выбрать объект (string)
filter - фильтр объектов для выбора вида '("LINE" "LWPOLYLINE")
entlist - список примитивов которые не надо выбирать (либо список entity name, либо PICKSET)

Примеры:
(Kr_entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") nil)
(Kr_entsel "\nВыберите объекты" nil nil)
(setq aa nil) (Kr_entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (while (setq a (car (entsel))) (setq aa (append aa (list a)))))
(Kr_entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (ssget))

|;

(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
);defun

Спасибо, огромное.

[Krieger]

Точно. Забыл её воткнуть.