[Red Nova]

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (Visual foxpro) программку типа суммирования столбцов списал у соседа (это уже в университете).
Не смотря на эте намерен научится писать программы для Автокада на лиспе, скачал книгу Хювенена, несколько примеров создания программ, но после получасового “смотрения” таких книг мое мышление явно притормаживает.
Решил пойти другим путем.
Нашел самый короткий лисп из моей коллекции, и прошу программистов с этого форума пошагово объяснить какой символ что означает. Надеюсь на вашу помощь.

Код:

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

(defun c:make-blocks-explodeable (/ adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (vlax-for blk_def (vla-get-blocks adoc)
    (if (and (equal (vla-get-isxref blk_def) :vlax-false)
             (equal (vla-get-islayout blk_def) :vlax-false)
             ) ;_ end of and
      (vl-catch-all-apply '(lambda () (vla-put-explodable blk_def :vlax-true)))
      ) ;_ end of if
    ) ;_ end of vlax-for
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

_____________________________________________________________________________________________________________

Прошло много лет и топик теперь представляет из себя площадку для обучения азов программирования для многих начинающих.
Так что начинающие лиспогрызы приветствуются .

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

Pavel_GP, ты отредактировал пост позднее, чем я дал ответ.

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc (append angl_1 (list (car angl_1)))

Вместо car ты наверное хотел поставить cdr

----- добавлено через 54 сек. -----

Сорь, мысли гуляют пытаюсь внятное подать

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

Ты сначала просил дополнить список - поставить в конец первый элемент. Я дал решение.
P.S. С

Сообщение от Pavel_GP (a (/ (a+b) 2.) (/ (b+c) 2.) ... (/ (g+n) 2.) n), где второй список это среднее между 1 и 2 углами и т.д. а последний угол это просто угол

просто угол - это откуда докуда угол? В качестве варианта:

Код:

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

 (defun tt (lst / res count)
  ;; (tt (mapcar 'cdr (vl-remove-if-not '(LAMBDA(x)(=(car x) 10)) (entget(car(entsel))))))
  (setq count 0)
  (mapcar
    (function
      (lambda (x / tmp)
          ;  (- pi
        (cond
          ((= count 0)
           (setq tmp   (angle x (nth (1+ count) lst))
                 count (1+ count)
                 ) ;_ end of setq
           tmp
           )
          ((= count (1- (length lst))) (angle (nth (1- count) lst) x))
          (t
           (setq tmp   (* (+ (angle (nth (1- count) lst) x)
                             (angle x (nth (1+ count) lst))
                             ) ;_ end of +
                          0.5
                          ) ;_ end of *
                 count (1+ count)
                 ) ;_ end of setq
           tmp
           )
          ) ;_ end of cond
          ; ) ;_ end of -
        ) ;_ end of lambda
      ) ;_ end of function
    lst
    ) ;_ end of mapcar
  ) ;_ end of defun

[Pavel_GP]

Спс.
1. Куда вставить функцию, где ее применить?
2. Если применить вот так ( setq ugol (tt angl_1)), то не правильный тип аргумента 2D/3D, скорее всего ругается функция angle.
3. Если убрать комментарий (;; (tt ....)), то требуется выбрать объект.

Сообщение от Кулик Алексей aka kpblc просто угол - это откуда докуда угол?

см. вложение.

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

Pavel_GP, я в комментарии специально показал пример вызова. Скопируй код и вызывай так, как написано в комментарии.

[Pavel_GP]

Отлично!!!

Только можно отредактировать чтобы не запрашивал выбрать объект, я его уже выбираю до функции.
Спасибо.
А есть у тебя lisp функции offset (которая родная в автокаде)?

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

Сообщение от Pavel_GP можно отредактировать чтобы не запрашивал выбрать объект, я его уже выбираю до функции.

Можно. Редактируй.

Сообщение от Pavel_GP есть у тебя lisp функции offset (которая родная в автокаде)?

Нет. У тебя более чем достаточно информации для того, чтобы сделать нужный тебе функционал самостоятельно.

[Pavel_GP]

"блин" сам допер, туплю, ну извиняйте... (entsel) заменил на свою переменную obj

[Pavel_GP]

1. Посмотри плз код и помоги с расстановкой глобальных переменных.
2. Если начать следующее построение, то после построения полилинии цепляются к ней (строятся все заново) прошлые построения.
Спс.
Пысы: Если не трудно где добавить и что, чтобы полилиния строилась красного цвета толщиной вес 0.3

----- добавлено через ~19 ч. -----

Сообщение от Pavel_GP 1. Посмотри плз код и помоги с расстановкой глобальных переменных. 2. Если начать следующее построение, то после построения полилинии цепляются к ней (строятся все заново) прошлые построения. Спс.

Вопрос снят.

Сообщение от Pavel_GP Если не трудно где добавить и что, чтобы полилиния строилась красного цвета вес 0.3

Вопрос открыт снят.

Код:

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

 (setq entg (entget (entlast)))
	    (entmod (append entg (list (cons 370 30) (cons 62 1))))

[Pavel_GP]

Привет. Нужна функция сумма чисел в списке.
Пример: lst (1 2 3 4) 10, могут быть и не целые.
Спс. Вопрос снят.

Код:

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

 (apply '+ lst)

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc Код: [Выделить все] (defun tt (lst / res count) ;; (tt (mapcar 'cdr (vl-remove-if-not '(LAMBDA(x)(=(car x) 10)) (entget(car(entsel)))))) (setq count 0) (mapcar (function (lambda (x / tmp) ; (- pi (cond ((= count 0) (setq tmp (angle x (nth (1+ count) lst)) count (1+ count) ) ;_ end of setq tmp ) ((= count (1- (length lst))) (angle (nth (1- count) lst) x)) (t (setq tmp (* (+ (angle (nth (1- count) lst) x) (angle x (nth (1+ count) lst)) ) ;_ end of + 0.5 ) ;_ end of * count (1+ count) ) ;_ end of setq tmp ) ) ;_ end of cond ; ) ;_ end of - ) ;_ end of lambda ) ;_ end of function lst ) ;_ end of mapcar ) ;_ end of defun

Ув. akka_KPblC, поправь плз код согласно вложения: Красный цвет углов, это как щас строит, Зеленый цвет, как пока нужно.

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

Pavel_GP, я не вникал в твой алгоритм, я всего лишь его адаптировал. Сними комментарии со строк 7 и 27 - попробуй. Похоже, я скинул какой-то из тестовых вариантов.

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc Pavel_GP, я не вникал в твой алгоритм, я всего лишь его адаптировал. Сними комментарии со строк 7 и 27 - попробуй. Похоже, я скинул какой-то из тестовых вариантов.

Комментарии я снимал.
Извини откорректировал вложение.

----- добавлено через ~3 мин. -----
1. Если тебе это поможет, то углы между вершинами автокад вычисляет от оси Х против часовой стрелки
2. Еще дополню, а углы которые я нарисовал - это азимуты от оси Y по часовой стрелки.
3. В ком. (7,27) я подставляю значения либо pi или 2pi., но они на алгоритм не влияют, мне кажется дело в этой функции.
4. Еще дополню, в ком (7) знак сменить на "+", вместо pi поставить коэффициент (к), который будет равен либо 0 либо pi, в зависимости от стороны смещения вправо=0, влево=pi. Отсюда следует при выборе справо, угол (между двумя вершина) будет равен Азимуту, но при угле=0, Азимут=180. Азимут это результат твоей функции.
5. Когда вычисляем среднее между Азимутами, нужно учесть, что если значение у крайних азимутов больше 360° (6.283185307179586), то (у каждого которого > 360°) перед вычислением среднего, от полученного значения отнять 360°

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

Pavel_GP, ты про углы в курсе? Что pi = 180°, а (* 2. pi) = 360°? У тебя абсолютно непонятные требования - и при этом ты почему-то не показываешь свой код. И не показываешь, на каком месте у тебя "спотык".

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc Pavel_GP, ты про углы в курсе?

Семен Семеныч, я в курсе, я для подробно описываю ситуацию, чтоб тщательнее разобраться.

Код:

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

 ;;; Аналог off_set только для проекции Меркатора
;;; Большая отдельная благодарность Кулик Алексей akka_KPbIC http://forum.dwg.ru
(defun C:PPM (/	     dtr    ao	   bo	  f_ps	 fg	e1     e1_2
	      e2     e2_2   s	   sfg2	  ko	 pt	xi     tt
	      azimut_s	    Az	   coords *cdl_actvdoc*	LWPoly vertex
	      x1     x2	    ugol1  ugol2  obj	 ent	OSM    k
	      y_pt   y1	    y2
	     )
  (setq OSM (getvar "OSMODE"))		;запоминаем значение объективной привязки
  (setvar "OSMODE" 0)			;выключаем объективную привязку
  (vl-load-com)
;;; Настраиваем систему координат WGS84
;;; Вспомогательные функции
  (defun dtr (a) (* pi (/ a 180.)))
  (defun deg (r) (/ (* r 180.) pi))

;;; -----------------параметры эллипсоида WGS84----------------------
  (setq	ao   6378137.			;большая полуось
	bo   6356752.3142		;малая полуось
	f_ps (/ 1. 298.25722356)	;первое сжатие
	e1   0.0818191909289067		;первый эксцентриситет
	e1_2 (sqrt (/ (- (expt ao 2.) (expt bo 2.)) (expt bo 2.)))
					;второй эксцентриситет
	e2_2 (expt e1_2 2.)
	e2   (* f_ps (- 2. f_ps))
  )
  (setq fg (getreal "\n Введите главную параллель, xx.xxx°: "))
  (setq fg (dtr fg))			;перевод градусов в радианы
  (setq s (getdist "\n Укажите расстояние смещения, метры:"))
  (setq sfg2 (expt (sin fg) 2.))
  (setq	ko (/ (cos
		fg
	      ) ;_end of cos
	      (expt (- 1. (* e2 sfg2)) 0.5)
	   ) ;_end of /
  ) ;_end of setq ko

  (if (setq obj (entsel "\n Выбрать полилинию : ")) ;|<Имя объекта:|;
    (progn
      (if (and (= (type	(setq ent (vl-catch-all-apply ;|#<VLA-OBJECT|;
				    (function
				      (lambda ()
					(car obj)
				      ) ;_ end of LAMBDA
				    ) ;_ end of function
				  ) ;_ end of VL-CATCH-ALL-APPLY
			) ;_ end of setq ent
		  ) ;_ end of type
		  'ename
	       ) ;_ end of =
	       (setq ent (vlax-ename->vla-object ent))
	       (= (vla-get-objectname ent) "AcDbPolyline")
	  ) ;_ end of and
	(progn
	  (setq	pt
		 (getpoint "\n Уажите точку, определяющую сторону смещения"
		 )
	  ) ;_end setq pt
	  (setvar "OSMODE" OSM)		;включаем объективную привязку
;;;получение списка координат вершин полилинии
	  (setq
	    xy_v (mapcar 'cdr
			 (vl-remove-if-not
			   '(lambda (x) (= (car x) 10))
			   (entget (car obj))
			 ) ;_end vl-remove-if-not
		 ) ;_end of mapcar
	  ) ;_end of setq xy_v

;;; записываем азимуты
	  (defun tt (xy_v / res count)
	    (setq ugol1	(angle (car xy_v) pt) ;вспомогательные величины
		  ugol2	(angle (car xy_v) (cadr xy_v))
					;для определения			
		  x1	(caar xy_v)	;стороны смещения
		  x2	(caadr xy_v)
		  y_pt	(cadr pt)
		  y1	(cadar xy_v)
		  y2	(cadadr xy_v)
	    ) ;_end of setq(s)
	    (cond ((and (= y1 y2) (= ugol2 0) (< y_pt y1))
		   (setq k pi)
		  )
		  ((and (= y1 y2) (> ugol2 ugol1))
		   (setq k pi)
		  )
		  ((and (= y1 y2) (< ugol2 ugol1))
		   (setq k (* 2. pi))
		  )
		  ((and (= x1 x2) (> ugol2 ugol1))
		   (setq k pi)
		  )
		  ((and (= x1 x2) (< ugol2 ugol1))
		   (setq k (* 2. pi))
		  )
		  ((and (< x1 x2) (> y_pt y1) (> ugol2 ugol1) (< y1 y2))
		   (setq k pi)
		  )
		  ((and (< x1 x2) (> y_pt y1) (> ugol2 ugol1))
		   (setq k (* 2. pi))
		  )
		  ((and (< x1 x2) (< y1 y2) (< ugol2 ugol1) (< y_pt y1))
		   (setq k pi)
		  )
		  ((and (> ugol2 ugol1) (< x1 x2))
		   (setq k pi)
		  )
		  ((and (< ugol2 ugol1) (< x1 x2))
		   (setq k (* 2. pi))
		  )
		  ((and (> ugol2 ugol1) (> x1 x2))
		   (setq k pi)
		  )
		  ((and (< ugol2 ugol1) (> x1 x2))
		   (setq k (* 2. pi))
		  )
	    ) ;_end of cond
	    (setq count 0)
	    (mapcar
	      (function
		(lambda	(x / tmp)
		  (-
		  k
		  (cond
		    ((= count 0)
		     (setq tmp	 (angle x (nth (1+ count) xy_v))
			   count (1+ count)
		     ) ;_ end of setq
		     tmp
		    )
		    ((= count (1- (length xy_v)))
		     (angle (nth (1- count) xy_v) x)
		    )
		    (t
		     (setq tmp	 (* (+ (angle (nth (1- count) xy_v) x)
				       (angle x (nth (1+ count) xy_v))
				    ) ;_ end of +
				    0.5
				 ) ;_ end of *
			   count (1+ count)
		     ) ;_ end of setq
		     tmp
		    )
		  ) ;_ end of cond
					) ;_ end of -
		) ;_ end of lambda
	      ) ;_ end of function
	      xy_v
	    ) ;_ end of mapcar
	  ) ;_ end of defun

	  (setq	azimut_s ;|список азимутов|;
		 (tt (mapcar 'cdr
			     (vl-remove-if-not
			       '(LAMBDA (x) (= (car x) 10))
			       (entget (car obj))
			     ) ;_end of vl-remove-if-not
		     ) ;_end of mapcar
		 ) ;_end of tt
	  ) ;_end of setq
;;; получаем новый список координат вершин
	  (setq n 0)
	  (foreach vertex xy_v
	    (setq Az (nth n azimut_s))
	    (defun eval-new-coords (x	  y	/     mo    f_r	  l_r
				    nym2  c	Nm    Mm    betta gamma
				    alfa  b	w     fnew_r	  lnew_r
				    x0	  y0	tan   xy_new
				   )
	      (setq mo (- (/ pi 2.)
			  (* 2.
			     (atan (exp	(/ (* -1. y) (* ao ko))
				   ) ;_end of exp
			     ) ;_end of atan
			  ) ;_end of *
		       ) ;_end of -
	      ) ;_end of setq mo
;;; преобразование прямоугольных в географические координаты
	      (setq f_r
		     (+	(+ (+ (+ mo
				 (* (sin (* 2. mo))
				    (+ (+ (+ (/ (expt e1 2.) 2.)
					     (* 5. (/ (expt e1 4.) 24.))
					  ) ;_end of +
					  (/ (expt e1 6.) 12.)
				       ) ;_end of +
				       (* 13. (/ (expt e1 8.) 360.))
				    ) ;_end of +
				 ) ;_end of *
			      ) ;_end of +
			      (* (sin (* 4. mo))
				 (+ (+ (* 7. (/ (expt e1 4.) 48.))
				       (* 29. (/ (expt e1 6.) 240.))
				    ) ;_end of +
				    (* 811. (/ (expt e1 8.) 11520.))
				 ) ;_end of +
			      ) ;_end of *
			   ) ;_end of +
			   (* (sin (* 6. mo))
			      (+ (* 7. (/ (expt e1 6.) 120.))
				 (* 81. (/ (expt e1 8.) 1120.))
			      ) ;_end of +
			   ) ;_end of *
			) ;_end of +
			(* (sin (* 8. mo))
			   (* 4279. (/ (expt e1 8.) 161280.))
			) ;_end of *
		     ) ;_end of +
	      ) ;_end of setq f_r
	      (setq f_r	  (abs f_r)	; широта в радианах
		    l_r	  (/ x (* ao ko))
		    l_r	  (abs l_r)	; долгота в радианах
;;; вычисление новых координат вершин

;;; **************************************************************
		    nym2  (* e2_2 (expt (cos f_r) 2.))
		    c	  (* bo (+ 1. e2_2))
		    Nm	  (/ c (sqrt (+ 1. nym2)))
		    Mm	  (/ Nm (+ 1. nym2))
		    betta (/ (* s (cos Az)) Mm)
		    gamma (/ (* s (sin Az)) (* Nm (cos f_r)))
		    alfa  (sin f_r)
		    b	  (* betta (1+ (/ (+ (* 2. (expt gamma 2.))) 24.)))
	      ) ;_end of setq(s)
	      (setq
		w (* gamma
		     (1+ (/ (- (expt alfa 2.) (expt betta 2.)) 24.))
		  ) ;_end of *
	      ) ;_end of setq w
	      (setq fnew_r (+ f_r b))	;широта новой вершины
	      (setq lnew_r (+ l_r w))	;долгота новой вершины

;;; **************************************************************		  

	      (setq x0 (* (* ao ko) lnew_r))
	      (setq tan	(/ (sin (+ (/ pi 4.) (/ fnew_r 2.)))
			   (cos (+ (/ pi 4.) (/ fnew_r 2.)))
			) ;_end of /
	      ) ;_end of setq tan
	      (setq y0 (* (* ao ko)
			  (log (* tan
				  (expt	(/ (- 1. (* e1 (sin fnew_r)))
					   (+ 1. (* e1 (sin fnew_r)))
					) ;_end of /
					(/ e1 2.)
				  ) ;_end of expt
			       ) ;_end of *
			  ) ;_end of expt
		       ) ;_end of *
	      ) ;_end of setq y0
	      (setq xy_new (list x0 y0)); список прямоугольных координат новой вершины
	    ) ;_end of defun eval-new-coords
;;; список прямоугольных координат новых вершин
	    (setq coords
		   (cons (eval-new-coords (car vertex) (cadr vertex))
			 coords
		   ) ;_end of cons
	    ) ;_end of setq coords
	    (setq n (1+ n))
	  ) ;_end of foreach

	  (setq	*cdl_actvdoc*
		 (vla-get-ActiveDocument
		   (vlax-get-acad-object)
		 ) ;_end of vla-get-ActiveDocument
	  ) ;_end of setq *cdl_actvdoc*
;;; Строим полилинию по новым вершинам
	  (defun LWPoly	(coords / templst entg)
	    (vla-AddLightWeightPolyline
	      (vla-get-Block (vla-get-ActiveLayout *cdl_actvdoc*))
	      (vlax-safearray-fill
		(vlax-make-safearray
		  vlax-vbDouble
		  (vl-list* 0
			    (1-	(length	(setq templst
					       (apply
						 'append
						 (mapcar
						   (function
						     (lambda (x)
						       (cond
							 ((= 3 (length x))
							  (reverse (cdr (reverse x)))
							 )
							 (T x)
						       ) ;_end of cond
						     ) ;_end of lambda
						   ) ;_end of function
						   coords
						 ) ;_end of mapcar
					       ) ;_end of apply
					) ;_end of setq templst
				) ;_end of length
			    ) ;_end of 1-
		  ) ;_end of vl-list*
		) ;_end of vlax-make-safearray
		templst
	      ) ;_end of vlax-safearray-fill
	    ) ;_end of vla-AddLightWeightPolyline
	    (setq entg (entget (entlast)))
	    (entmod (append entg (list (cons 370 30) (cons 62 1))))
	  ) ;_end of defun LWPoly
	  (LWPoly coords)
	) ;_end of progn
	(princ "\n Это не тип полилинии.")
      ) ;_end of if
    ) ;_end of progn
    (princ "\n Объект не выбран.")
  ) ;_end of if
  (princ)
  (gc)
) ;_end of defun C:PPM

Пояснение к работе с кодом:
1. Загрузи dwg (см. вложение).
2. Прими по запросу систему координат.
3. параллель 75
4. для удобства работы смещение ввожу 50

Сообщение от Кулик Алексей aka kpblc на каком месте у тебя "спотык".

Как такого "стоптыка" нет, По моему мнению не правильные значения получает azimut_s строка 152

----- добавлено через ~4 ч. -----
Добавлю:
1. Строки 72-117, расчет вспомогательного коэффициента при выборе стороны смещения. Я лично не могу сейчас додуматься, как конкретно программно при выборе стороны смещения (вправо/влево), программа понимала что, где вправо, а где влево. Поэтому я прописываю такие вычисления, скорее всего все намного проще.
2. 94 просмотра вложения, ни одного ответа

[Jerald]

Как программно переключить цвет?

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

Сообщение от Pavel_GP 94 просмотра вложения, ни одного ответа

Особенность движка - это не количество скачиваний, а количество просмотров страницы

Сообщение от Jerald Как программно переключить цвет?

Цвет чего?

[Jerald]

Сообщение от Кулик Алексей aka kpblc Цвет чего?

Текущий цвет.

[ProPeller]

Сообщение от Jerald Текущий цвет.

например

Код:

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

 (setvar "cecolor" "1")

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc Pavel_GP,ты почему-то не показываешь свой код.

Что скажешь по коду, жду твоего ответа...