Re: Разбивочный чертеж

Не знаю в чем проблема, вроде ничего, что может вызвать ошибку в локализованной версии больше не вставлял в код. Единственное, что могу предложить, если никто больше не поможет, подождать до вторника, протестирую на русской версии Acada. Сам работаю в нелокализованном Acade, а там код работает.
Наверное сам туплю где-то, как в случае с ssget, но опыта у меня маловато в программировании. Работаю проектировщиком, а программами занимаюсь, когда есть свободное время.

Re: Разбивочный чертеж

Бум ждать

Re: Разбивочный чертеж

Выступлю третейским судьей. Yri, что-то там у тебя не так. Autocad 2006 RUS SP1 код

> Donhuan
работает нормально.

Re: Разбивочный чертеж

Да я уж незнаю. У меня 2007 РУС вроде без всяких сервис паков.

Re: Разбивочный чертеж

> VVA
Спасибо за помощь.

> yri
Значит надо прогонять программу в режиме отладки в твоем Acad-е, чтобы выяснить где именно глюк.

Re: Разбивочный чертеж

Тоже самое AutoCAD 2007 RUS SP1 код > Donhuan (2008-03-26 01:06:42)работает
Про сервис паки смотри Справка->О программе->О продукте

Re: Разбивочный чертеж

> Donhuan
С большим удовольствием проверю - подскажите как?

Re: Разбивочный чертеж

В командной строке: _vlisp - запускает Visual Lisp.
Ищешь на панели и нажимаешь кнопку "New file", в открывшееся окне вставляешь код.
Устанавливаешь курсор на строке, с которой надо начать пошагово выполнять программу и ставишь там точку останова (на панели кнопка Toggle breakpoint) - должна появиться красная метка.
Далее меню Tools, пункт Load text in editor - загружает код программы для выполнения.
Потом переходишь в AutoCad и запускаешь программу как обычно geo_angle, выполнение программы должно остановиться на точке останова и открыться окно с кодом программы. Потом жмешь F8 и выполняешь программу пошагово, следишь за тем на какой функции произойдет переход на функцию (vl-catch-all-apply 'gp:line_angle)) (функция обработки ошибок в начале кода).
А воообще если хочешь разобраться с редактором Lisp читай Help, там есть обучающий курс на русском про создание садовой дорожки на Lisp.

Re: Разбивочный чертеж

Парадоксы-все заработало хотя ничего не изменял.Все "что доктор прописал" , осталось сделать панельку и кнопочку написать, чтоб не набирать каждый раз команду, а?

Re: Разбивочный чертеж

Кнопку можешь добавить сам через меню "Адаптация".

Re: Разбивочный чертеж

Спасибо всем , код успешно работает, а вот с кнопкой придется разбираться я не програмист.

Re: Разбивочный чертеж

Можно ли как-то доработать данную программу для вычисления азимутов, чтобы выбирать несколько последовательных отрезков (ход) и начальное направление, а подсчитывалось измеренный левый угол по часовой стрелке, последующий + предыдущий и - 360, если больше 360. И еще хотел спросить по angle - по какому принципу определяется в какую сторону от оси X отсчитывается угол?

Re: Разбивочный чертеж

Посмотрел здесь https://www.caduser.ru/forum/topic43289.html
описан способ определения угла между двумя линиями, но если мне нужно сделать это несколько раз, то можно ли как то подавить явное проставление углового размера?

Re: Разбивочный чертеж

> Diman-2
Не совсем понятен вопрос. Дело в том что я проектирую сети связи и с геодезией знаком поверхностно. Объясните алгоритм ручного выполнения вашей задачи, попробуем что-нибудь сделать.

Re: Разбивочный чертеж

Алгоритм таков:
есть несколько отрезков (line), конечная точка предыдущего является начальной последующего, выбираем все отрезки, затем выбираем отрезок, направление которого будет нулевым, вычисляем левый (по левую руку)  угол по ходу часовой стрелки между нулевым и последующим (это и будет азимут), далее вычисляем следующий такой угол образуемый вторым и третьим отрезками, суммируем с   предыдущим и если он больше 360, то отнимаем 360, и так далее, затем над каждой линией подписывам длины и вычисленные азимуты.

Re: Разбивочный чертеж

Заранее спасибо

Re: Разбивочный чертеж

Никто не поможет в таком трудном деле?
Может как-то можно доработать программу geo_angle, я попробовал применить ее к вышеописанной ситуации с последовательными отрезками, длины она посчитала нормально, а вот в углах закономерности нет - от азимута они отличаются то на 180, то на 360, то вовсе не отличаются, я так думаю тут дело в значениях, которые дает функция angle, в какую сторону от x они исчисляются я че то не пойму, вот.

Re: Разбивочный чертеж

> Diman-2
Имей терпение.  Работаю над твоей проблемой, просто хочу сделать универсальную функцию чтобы можно было применять и для предыдущей задачи.

Re: Разбивочный чертеж

Спасибо большое, извини за настойчивость

Re: Разбивочный чертеж

Программа решает как первоначальную так и новую задачи.
Не обрабатывает закольцованные последовательности линий.

;;;Igor Kireev (Donhuan) 07.2008. Для caduser.ru.
;;;mail: igkiv@tut.by
;;;Вызов функции: geo_angle.
;;;Глобальные переменные:
;;;*mspace* - указатель на пространство модели
;;;*fuzz* - точность сравнения точек
;;;*scale_l* - масштабный коэффициент длины линий
;;;*text_h* - высота текста
;;;*step_line* - величина отступа текста от линии
;;;*prec* - точность отображения координат при выводе в файл
;;;*mode* - режим отображения координат при выводе в файл
(vl-load-com)
(setq *fuzz* 0.01
      *scale_l* 1.0
      *text_h* 3.0
      *step_line* 1.0
      *prec* 3
      *mode* 2
)
(setq *mspace* (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
;ж****************************************
;главная функция
(defun c:geo_angle (/ select)
  (if (vl-catch-all-error-p
    (vl-catch-all-apply
      'ga:input_data))
    (progn
      (mapcar '(lambda(x)(vla-Highlight x :vlax-false)) (mapcar 'vlax-ename->vla-object select))
      (print "Выполнение функции прервано.")
  ))
  (princ)
)
;*****************************************
;*****************************************
;функция ввода данных
;;;list_line - список линий вида '(((x y) (x y)) ...)
;;;list_graph - вычисленный граф от начальной точки вида '((a (b nil) (c (d nil)) ...) (f nil) ...), где а,b... - линии '((x y) (x y))
(defun ga:input_data (/ f_line start_point zero_angle list_line list_graph d_file start_line var_)
  (setq d_file (open (getfiled "Файл результата" "" "xls" 1) "w"))
  (write-line "Начальная точка (x)\tНачальная точка (y)\tКонечная точка (x)\tКонечная точка (y)\tДлина\tУгол относительно оси x\tВычисленный угол" d_file)
  (princ "\nУкажите линии:")
  (setq select (vl-remove-if 'listp (mapcar (function cadr) (ssnamex (ssget '((0 . "LINE")))))))
  (mapcar '(lambda (x) (vla-Highlight x :vlax-true)) (mapcar 'vlax-ename->vla-object select)); подсветка списка
  (princ "\nУкажите начальную линию:")
  (while
    (vl-catch-all-error-p
      (setq f_line
        (vl-catch-all-apply
          'ssname (list (ssget "_:S") 0))))
  )
  (setq start_point (getpoint "Укажите точку схождения (начальную точку хода):"))
  (princ "\nВведите масштабный коэффициент для длины линий < ")
  (princ *scale_l*)
  (princ " >: ")
  (initget 6)
  (setq *scale_l* (if (not (setq var_ (getreal))) (princ *scale_l*) var_))
  (princ "\nВведите величину высоты текста < ")
  (princ *text_h*)
  (princ " >: ")
  (initget 6)
  (setq *text_h* (if (not (setq var_ (getreal))) (princ *text_h*) var_))
  (princ "\nВведите величину смещения между текстом и линией < ")
  (princ *step_line*)
  (princ " >: ")
  (initget 6)
  (setq *step_line* (if (not (setq var_ (getreal))) (princ *step_line*) var_))
  (setq start_line ((lambda (x y) (if (equal start_point x *fuzz*) (list x y) (list y x)))
                   (cdr (assoc 10 (entget f_line))) (cdr (assoc 11 (entget f_line)))))
  (setq zero_angle (angle (car start_line) (cadr start_line))); вычисление нулевого угла
  (setq list_line (mapcar '(lambda (x) (list (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint x))); получение списка координат линий
                                 (vlax-safearray->list (vlax-variant-value (vla-get-endPoint x))))) (mapcar 'vlax-ename->vla-object select)))
  (setq list_graph (ga:make_graph list_line (list start_point))); формирование графа
  (close d_file)
  (mapcar '(lambda(x) (vla-Highlight x :vlax-false)) (mapcar 'vlax-ename->vla-object select))
)
;******************************************
;******************************************
; функция расчета параметров и вывода результатов в файл и в текст
;;;line_coor - линия для обработки '((x y) (x y))
(defun ga:angle_text_draw (line_coor / real_angle angle_line angle_line_d center_line vla_name_text)
  (setq real_angle (angle (car line_coor) (cadr line_coor))); реальный угол линии
  (setq angle_line (angtos ((lambda (x y) (cond
                        ((> x y) (- y (- x y)))
                        ((< x 0) (- y (+ x y)))
                        (t (- y x))
                      )) (- real_angle zero_angle) (+ pi pi)) 1 4)); вычисленный угол
  (setq angle_line_d ((lambda (x) (strcat (substr angle_line 1 x) "%%d" (substr angle_line (+ 2 x)))) (vl-string-search "d" angle_line))); замена символа градуса
  (setq center_line (polar (car line_coor) real_angle (/ (distance (car line_coor) (cadr line_coor)) 2)))
  (setq vla_name_text (vla-addtext *mspace* (rtos (* *scale_l* (distance (car line_coor) (cadr line_coor))) 2 3) (vlax-3d-point center_line) *text_h*)); вывод текста
  (ga:rotate_text vla_name_text center_line 13 (list line_coor real_angle))
  (setq vla_name_text (vla-addtext *mspace* angle_line_d (vlax-3d-point center_line) *text_h*)); вывод текста
  (ga:rotate_text vla_name_text center_line 7 (list line_coor real_angle))
  (write-line (strcat (rtos (caar line_coor) *mode* *prec*) "\t"
              (rtos (cadar line_coor) *mode* *prec*) "\t"
              (rtos (caadr line_coor) *mode* *prec*) "\t"
              (rtos (cadadr line_coor) *mode* *prec*) "\t"
              (rtos (* *scale_l* (distance (car line_coor) (cadr line_coor))) *mode* *prec*) "\t"
              (angtos real_angle 1 4) "\t"
              angle_line)
  d_file)
)
;******************************************
;******************************************
; функция поворота текста вдоль линии
;;;x - параметр вида '(((x y) (x y)) угол)
(defun ga:rotate_text (vla_name_text center_line alignment x / tng_angle half_line gippot)
    (setq half_line (/ (distance (caar x) (cadar x)) 2)); половина линии между старт и конец
    (setq gippot (sqrt (+ (expt *step_line* 2) (expt half_line 2))))
    (setq tng_angle (atan *step_line* half_line)); угол для смещения текста от линии (предотвращение сливания с линией)
    (vlax-put-property vla_name_text "Alignment" alignment)
    ((lambda (point); поворот текста
       (vla-rotate vla_name_text (vlax-3d-point center_line) (car point))
       (vlax-put-property vla_name_text "TextAlignmentPoint" (cadr point)))
      (if (and (<= (cadr x) (* pi 1.5)) (> (cadr x) (/ pi 2)))
        (progn
          (list (+ (cadr x) pi)
            (if (= alignment acAlignmentTopCenter)
              (vlax-3d-point (polar (caar x) (+ (cadr x) tng_angle) gippot))
              (vlax-3d-point (polar (caar x) (- (cadr x) tng_angle) gippot))
            )))
        (progn
          (list (cadr x)
            (if (= alignment acAlignmentTopCenter)
              (vlax-3d-point (polar (caar x) (- (cadr x) tng_angle) gippot))
              (vlax-3d-point (polar (caar x) (+ (cadr x) tng_angle) gippot))
    )))))
  (vla-put-color vla_name_text 253); задание цвета текста
)
;******************************************
;******************************************
; формирование графа с вызовом функций вывода значений
;;;list_line_r - список линий '(((x y) (x y)) ...)
;;;list_point - список точек '((x y) ...)
(defun ga:make_graph (list_line_r list_point /)в
  ((lambda (x y z)
    (cond
      ((null list_line_r) nil)
      ((and (or (equal x y *fuzz*) (equal x z *fuzz*))
        (not (or (ga:member y (cdr list_point))
             (ga:member z (cdr list_point)))))
       (cons ((lambda (next_line)
        (ga:angle_text_draw next_line); отрисовка текста
        (list next_line (ga:make_graph list_line (cons (cadr next_line) list_point)))) (if (equal x y *fuzz*) (list y z) (list z y)))
                    (ga:make_graph (cdr list_line_r) list_point)))
      (t (ga:make_graph (cdr list_line_r) list_point))
    )
  ) (car list_point) (caar list_line_r) (cadar list_line_r))
)
;**************************************************
;**************************************************
; функция-аналог member для точек с использованием точности при сравнении
(defun ga:member (m_element m_list /)
  (cond
    ((null m_list) nil)
    ((equal m_element (car m_list) *fuzz*) t)
    (t (ga:member m_element (cdr m_list)))
  )
)
;**************************************************
(princ "\nЗапуск программы: geo_angle.")

P.S. > Diman-2 (2008-07-16 09:22:20) Подскажи как правильно назвать эти задачи, которые решает программа, хочу добавить в готовые программы да не знаю как тему обозвать.

Re: Разбивочный чертеж

Вообще то хорошо,только б если добавить возможность нумерации вершин диалогово-например-нумеровать автоматически или выбор из блока примитиво или что-то вроде...
(Во обнаглел)

Re: Разбивочный чертеж

> yri
Узлов линий имеется ввиду? В каком порядке нумеровать?

Re: Разбивочный чертеж

Наверное от исходной и по удапенности или от порядка выбираемых линий.

Re: Разбивочный чертеж

Испытываю программу: из первого направления почему-то отнимается 180, хотя оно меньше 360?
А надо - если угол первой линии относительно исходной пишется как есть, т.к. он не может превышать 360, потом суммируется этот угол (например 220) и угол между второй третьей линией (например 200) итого получается 220+200=420-360=60
Вот 60 - азимут третьей линии, далее прибавляем угол между третьей и четвертой (например 200), в итоге азимут четвертой линии - 260.

Re: Разбивочный чертеж

> Diman-2
Наверное не совсем понял задачу. Сделаем так: сформируй вручную файл с азимутами, как должно быть и скинь мне на маил, а там уж будет видно.
А вообще программа выполняет те же действия с углами, что и раньше, только сейчас дополнительно воспринимает линии в виде цепочки.