[Mazai]

Здраствуйте.
Вопрос в следующем. Я пытаюсь написать программку на Лисп, которая "поднимала" бы вершины 3D-полилинии на третью координату Z. Суть её в следующем - я поднимаю одну или две координаты Z вершины полилинии в ручную, а программка используя уравнение прямой по двум точкам задаёт для оставшихся вершин соответсвующие координаты Z.
P.S.: Изначально полилиния построена на нулевом уровне (у всех вершин координата Z=0)

[Малявка]

Mazai, эт ты зряяя...
Съедят-с...
Новый вопрос - новая тема. Да-с.
Так что плоди.

[VVA]

Mazai,
Пробуй. Когда-то что-то подобное писал для своих. Принцип такой же. Устанавливаешь Z нужных вершин, остальные по уравнению прямой.

Код:

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

(defun C:3DB ( / e1 e2 ed lst_PT lst_SL lst_Z len_LST i Zn Zk in ik dZ jj lst_ZN BUF osm)
  (defun subst-i (i itm lst) (setq i (1+ i))
  (mapcar '(lambda (x)(if (zerop (setq i (1- i))) itm x)) lst))
  (setvar "CMDECHO" 0)
  (while  (and (setq e2 (ssget "_:S:E:L" '((0 . "POLYLINE"))))
	       (setq e1 (ssname e2 0))
               (member '(100 . "AcDb3dPolyline")(entget e1))
	       )
    (setq e2 nil e2 e1)
    (setq lst_PT nil lst_Z nil lst_SL nil lst_ZN nil)
    (while (/= (cdr(assoc 0 (setq ed (entget (setq e2 (entnext e2)))))) "SEQEND")
      (setq lst_PT (append lst_PT (list (cdr(assoc 10 ed)))))
      (setq lst_Z  (append lst_Z (list (caddr (last lst_PT)))))
      )
    (setq lst_SL nil Zk 0)
    (setq e2 (car lst_PT))
    (foreach ed lst_PT
      (setq lst_SL (append lst_SL (list (setq Zk (+ Zk (distance (list (car e2)(cadr e2))(list (car ed)(cadr ed))))))))
      (setq e2 ed)
      )
    (setq len_LST (length lst_Z))
    (setq i 0)
    (setq lst_ZN lst_Z)
    (while (< i len_LST)
      (cond ((= i 0)(setq Zn (nth i lst_Z) Zk Zn in i ik i))
	    ((= i (- len_LST 1))(setq Zn (nth i lst_Z) Zk Zn in i ik i))
	    (t
	     (while (and (nth i lst_Z)(zerop (nth i lst_Z)))(setq i (1+ i)))
	     (if (null (nth i lst_Z))(setq i (1- i)))
	     (setq Zk (nth i lst_Z))
	     (setq ik i)
	     (setq BUF (MAPCAR '(LAMBDA (AA)(- AA (nth in lst_SL))) lst_SL))
	     (setq dZ (- Zk Zn))
	     (setq e2 (- (nth ik lst_SL)(nth in lst_SL)))
	     (setq ed (/ dZ e2))
	     (setq jj in)
	     (while (< jj ik)
	       (setq e2 (+ (nth in lst_Z)(* ed (nth jj BUF))))
	       (setq lst_ZN (subst-i jj e2 lst_ZN))
	       (setq jj (1+ jj))
	       )
	     (setq in ik)
	     (setq Zn Zk)
	     )
	)
      (setq i (1+ i))
      )
    (setq i 0)(setq lst_SL nil)
    (foreach ed lst_PT
      (setq lst_SL (append lst_SL (list (list (car ed)(cadr ed)(nth i lst_ZN)))))
      (setq i (1+ i))      
    )
    (setq osm (getvar "OSMODE"))
    (setvar "osmode" 0)   
    (command "_.3DPOLY")
    (foreach ed lst_SL (command ed))
    (command "")
    (entdel e1)
    (setvar "osmode" osm)
  );_end of while
  (princ)
)

[Mazai]

Вычисление уравнения прямой по двум точкам.

Подскажите пожалуйста, как можно произвести вычисления более точно. Дело в том, что когда мы извлекаем координаты точки из чертежа, то нам передаются значение с точностью до 4-х знаков после запятой. Оказываеться - этого не совсем достаточно для расчёта в формуле уравнения прямой по двум точкам. Если попытаться проверить вычисленные значения с реальными, которые должны были бы получиться, то вычисленный результат не имеет достаточную точность. Посоветуйте, как можно достичь нужной точности, хотя бы 2 знака после запятой.

Возможно ли извлекать значение координат с большей точностью? Или как-то стоит модифицировать функцию для расчёта?

Код:

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

;|===========================================================================
*	Функция расчёта Z-координат точки по уравнению прямой по двум точкам
*	Параметры вызова:
		Point	- координаты точки, для которой надо расчитать Z
		Pt1 	- координаты 1-ой известной точки
		Pt2 	- координаты 2-ой известной точки
============================================================================|;
(defun new_Point (Point Pt1 Pt2 / X X1 X2 Z Z1 Z2)
  (if (and Point Pt1 Pt2)
    (progn
      (setq X  (nth 0 Point)
	    X1 (nth 0 Pt1)
	    Z1 (nth 2 Pt1)
	    X2 (nth 0 Pt2)
	    Z2 (nth 2 Pt2)
      ) ;_ end setq
      (if (eq 0 (- X2 X1))
	(setq Z Z1)
	(setq Z (+ (* (/ (- X X1) (- X2 X1)) (- Z2 Z1)) Z1))
 	;_ Z = ((X-X1)/(X2-X1))*(Z2-Z1) + Z1
      ) ;_end if
      (setq Point (reverse (append (list Z) (cdr (reverse Point)))))
    ) ;_ end progn
  ) ;_ end if
) ;_ end defun new_Point

[VVA]

Модифицировать ф-цию не нужно, Автокад работает с числами до 10 в 23-й степени. Просто показывает не все
Сравни

Код:

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

(mapcar '(lambda(x)
	   (terpri)
	   (princ (rtos x 2 12))
	   )
	(NEW_POINT (getpoint "\nPoint 1:")(getpoint "\nPoint 2:")(getpoint "\nPoint 3:"))
	)

*** Добавлено
Можно посмотреть ответ Александра Ривилиса здесь
http://www.caduser.ru/cgi-bin/f1/board.cgi?t=42490kq

[KAI]

В Toolpac есть такая программа.
Нечто похожее (только по конечным точкам) можно найти на http://geol-dh.ru (3D_SLANT)