Методические материалы по разработке СТУ и СМИС, СМИК, СУКС
Показать сообщение отдельно
Непрочитано 08.09.2006, 13:08 #1
Lisp - проблема с получением точки?
Кулик Алексей aka kpblc
Moderator
 
LISP, C# (ACAD 200[9,12,13,14])
 
С.-Петербург
Регистрация: 25.08.2003
Сообщений: 37,652

Мой вариант получения точки, к сожалению, работает только на виде "сверху" или "снизу".
Есть несколько вопросов:
1. Как сделать работу в любой системе координат, с корректным построением временного отрезка?
2. Как отследить клавиатурный ввод?
Собственно код:
Код:
[Выделить все]
;|
*    Получение точки от базовой под переданным углом (радиан). Получение
* идет с построением временного отрезка. проверено только в WCS
*    Параметры вызова:
*	start-point	начальная точка. nil -> вводится пользователем
*	ang		угол, под которым выполнять "вычисление" точки
*			Возможно указание "диапазона" углов списком (в радианах)
*		вида:
	      '(("ucs" . t)	; учитывать или нет возможные повороты ucs
		("base" . 0.)	; "базовый" угол, вдоль которого вычислять точку
				; При установленной ucs за 0 принимается угол поворота текущей ucs
				; nil -> определяется пользователем
		("step" . pi)	; "шаг" смещений.
*    Примеры вызова:
(_kpblc-get-point-with-start-and-angle nil nil)
(_kpblc-get-point-with-start-and-angle nil '(("ucs" . t)))
(_kpblc-get-point-with-start-and-angle nil '(("ucs" . t) ("base" . 0.)))
(_kpblc-get-point-with-start-and-angle nil (list '("ucs" . t) (cons "base" (/ pi 2.)) (cons "step" (/ pi 4.))))
(_kpblc-get-point-with-start-and-angle '(0. 0. 0.) (list '("ucs" . t) (cons "base" (/ pi 2.)) (cons "step" (/ pi 4.))))
|;

(defun _kpblc-get-point-with-start-and-angle (start-point  ang
					      /		   loc:deltemp
					      *error*	   ent_temp
					      ucs_angle	   res
					      rot_angle	   rot_steps
					      )
  (defun loc:deltemp ()
    (if	(and ent_temp (not (vlax-erased-p (_kpblc-conv-ent-to-vla ent_temp))))
      (entdel ent_temp)
      ) ;_ end of if
    ) ;_ end of defun
  (defun *error* (msg)
    (loc:deltemp)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (if (not start-point)
    (setq start-point (getpoint "Укажите начальную точку <Выход> : "))
    ) ;_ end of if
  (if start-point
    (progn
      (entmake (list (cons 0 "LINE")
		     (cons 10 (trans start-point 1 0))
		     (cons 11
			   (list (1+ (car (trans start-point 1 0)))
				 (cadr (trans start-point 1 0))
				 (caddr (trans start-point 1 0))
				 ) ;_ end of list
			   ) ;_ end of cons
		     ) ;_ end of list
	       ) ;_ end of entmake
      (setq ent_temp (entlast))
      (while (and (setq res (grread 3 0)) (= (car res) 5))
	(setq res	(cadr res)
	      ucs_angle	(if (cdr (assoc "ucs" ang))
			  (angle (getvar "ucsorg")
				 (mapcar '+ (getvar "ucsorg") (getvar "ucsxdir"))
				 ) ;_ end of angle
			  0.
			  ) ;_ end of if
	      rot_angle	(angle (trans start-point 1 0) (trans res 1 0))
	      ) ;_ end of setq
	(if (cdr (assoc "base" ang))
	  (progn
	    (setq ucs_angle (+ ucs_angle (cdr (assoc "base" ang))))
	    (if	(cdr (assoc "step" ang))
	      (repeat (atoi (rtos (/ (* 2 pi) (cdr (assoc "step" ang)))))
		(setq rot_steps
		       (append
			 rot_steps
			 (list
			   (if rot_steps
			     (+ (last rot_steps) (cdr (assoc "step" ang)))
			     (cdr (assoc "step" ang))
			     ) ;_ end of if
			   ) ;_ end of list
			 ) ;_ end of append
		      ) ;_ end of setq
		) ;_ end of REPEAT
	      ) ;_ end of if
	    ) ;_ end of progn
	  ) ;_ end of if
	(if rot_steps
	  (setq	ucs_angle (car (vl-sort	rot_steps
					'(lambda (a b)
					   (< (abs (- rot_angle a))
					      (abs (- rot_angle b))
					      ) ;_ end of <
					   ) ;_ end of lambda
					) ;_ end of vl-sort
			       ) ;_ end of car
		) ;_ end of setq
	  ) ;_ end of if
	(_kpblc-ent-modify-autoregen
	  ent_temp
	  11
	  (if (cdr (assoc "base" ang))
	    (polar
	      (trans start-point 1 0)
	      ucs_angle
	      (* (cos
		   (- rot_angle ucs_angle)
		   ) ;_ end of cos
		 (distance (trans start-point 1 0) (trans res 1 0))
		 ) ;_ end of *
	      ) ;_ end of polar
	    (trans res 1 0)
	    ) ;_ end of if
	  t
	  ) ;_ end of _kpblc-ent-modify-autoregen
	) ;_ end of while
      ) ;_ end of progn
    ) ;_ end of if
  (loc:deltemp)
  (cond
    ((= (car res) 2)
     (_kpblc-get-point-with-start-and-angle start-point ang)
     )
    ((= (car res) 3)
     (trans (cadr res) 1 0)
     )
    (t nil)
    ) ;_ end of cond
  ) ;_ end of defun
Использует функцию модификации примитива
Код:
[Выделить все]
;|=============================================================================
*    Функция модификации указанного бита примитива
*    Параметры вызова:
*	entity	- примитив, полученный через (entsel), (entlast) etc
*	bit	- dxf-код, значение которого надо установить
*	value	- новое значение
*	regen	- выполнять или нет регенерацию примитива сразу. t/ nil
*    Примеры вызова:
(_kpblc-ent-modify (entlast) 8 "0" t)	; перенести последний примитив на слой 0
(_kpblc-ent-modify (entsel) 62 10 nil)	; установить выбранному примитиву цвет 10
*    Возвращаемое значение:
*	примитив с модифицированным dxf-списком. Примитив перерисовывается в
* зависимости от значения ключа ext_regen
=============================================================================|;
(defun _kpblc-ent-modify-autoregen (ent	       bit	  value	     ext_regen
				    /	       ent_list	  old_dxf    new_dxf
				    layer_dxf70
				    )
  (setq ent (_kpblc-conv-ent-to-ename ent))
  (if (not
	(and
	  (or
	    (= (strcase (cdr (assoc 0 (entget ent))) nil) "STYLE")
	    (= (strcase (cdr (assoc 0 (entget ent))) nil) "DIMSTYLE")
	    (= (strcase (cdr (assoc 0 (entget ent))) nil) "LAYER")
	    ) ;_ end of or 
	  (= bit 100)
	  ) ;_ end of and 
	) ;_ end of not 
    (progn
      (setq ent_list (entget ent)
	    new_dxf  (cons bit
			   (if (and (= bit 62) (= (type value) 'str))
			     (if (= (strcase value) "BYLAYER")
			       256
			       0
			       ) ;_ end of if 
			     value
			     ) ;_ end of if 
			   ) ;_ end of cons 
	    ) ;_ end of setq 
      (if (not (equal new_dxf (setq old_dxf (assoc bit ent_list))))
	(progn
	  (entmod (if old_dxf
		    (subst new_dxf old_dxf ent_list)
		    (append ent_list (list new_dxf))
		    ) ;_ end of if 
		  ) ;_ end of entmod
	  (if ent_regen
	    (entupd ent)
	    (redraw ent)
	    ) ;_ end of if
	  ) ;_ end of progn 
	) ;_ end of if 
      ) ;_ end of progn 
    ) ;_ end of if 
  ent
  ) ;_ end of defun
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Просмотров: 2214
 
Система Техэксперт
Размещение рекламы