Как найти дирекционный угол в автокаде

Добро пожаловать!

Войдите или зарегистрируйтесь сейчас!

Войти

1. 
   

   Форумчанин

   Регистрация:

   31 окт 2009

   Сообщения:

   28

   Симпатии:

   1

   Адрес:

   Красноярск

   Доброго времени суток, в этом деле новичок и хотел проконсультироваться. Вот дан фрагмент топографической карты района, на нем нанесены только координаты границ участков. Я вот вручную могу посчитать длину стороны участка (через разницу координат) и дерикционный угол, ну а затем и внутренний. А какая программка может облегчить мой труд. Подскажите пожалуйста, буду признателен

   #1

2. 
   

   Команда форума
   Форумчанин

   Да практически любая, котороя позволяет обрабатывать геодезические данные.
   Например, Кредо

   #2

3. 
   

   Форумчанин

   Регистрация:

   30 ноя 2007

   Сообщения:

   2.702

   Симпатии:

   2.442

   Адрес:

   Сибирь

   
   Обратная геодезическая задача(ОГЗ) заключается в определении по геодезическим координатам двух точек на земном эллипсоиде длины и дирекционного угла направления между этими точками.

   #3

4. 
   

   Форумчанин

   Регистрация:

   31 окт 2009

   Сообщения:

   28

   Симпатии:

   1

   Адрес:

   Красноярск

   а как мне через автокад или кредо посчитать все это???

   #4

5. 
   

   Форумчанин

   Так у вас на бумаге ваша карта??

   #5

6. 
   

   Форумчанин

   Регистрация:

   31 окт 2009

   Сообщения:

   28

   Симпатии:

   1

   Адрес:

   Красноярск

7. 
   

   Форумчанин

   Хотя не столь важно, берете Автокад, выбираете примитив «Полилиния» и вводите координаты первой точки, сначала У, потом через запятую X, ввели — жмете Enter, у вас появится первая, точка, ничего не тыкая, вводите координаты второй точки, у вас появится первая сторона…ну и так далее поочереди вводите все ваши точки -получится многоугольник, где вы с помощью линейных размеров и углового измерителя все что нужно измерите…можно все и в ручную, без программ посчитать, но вы просите программы, потому вот такой вариант…
   Если не получится — кидайте сюда координаты всех точек, посчитаем!

   #7

8. 
   

   Форумчанин

   Регистрация:

   31 окт 2009

   Сообщения:

   28

   Симпатии:

   1

   Адрес:

   Красноярск

   вот такие координаты, как в автокаде сделать? Я попробовал, первую забиваю и от центра отрезок бац и ушел за пределы видимости, прописываю вторую точку, аналогично получается, что ничего не получается. вот. Подскажите плиз

   Вложения:

   #8

9. 
   

   Форумчанин

   Регистрация:

   1 мар 2009

   Сообщения:

   1.152

   Симпатии:

   118

   Адрес:

   Воронеж

   1.Ушел за пределы видимости потому,что ошибка в знаменателе одной из координат(все должны начинаться на 64
   2.В вашем варианте в числителе Y, а в знаменателе X

   #9

10. 
    

    Форумчанин

    Ошибка по У, вместо 842138,812 должно быть 642138,812,

    #10

11. 
    

    Форумчанин

    1.Рисуеш в автокаде полилинией! фигуру с нужным количеством углов.
    2. Выделяем полилинию .
    3.Правкнопкой мыши — свойства.
    4.В Свойствах -Верщина выбираем поочередно номера вершин ниже изменяем координаты.
    5. В Вершина Х вбиваем координаты, Вершина Х вбиваем координаты.

    #11

12. 
    

    Форумчанин

    Регистрация:

    31 окт 2009

    Сообщения:

    28

    Симпатии:

    1

    Адрес:

    Красноярск

    угу, нашел а остальные тоже уходят за пределы

    #12

13. 
    

    Форумчанин

14. 
    

    Форумчанин

    Регистрация:

    31 окт 2009

    Сообщения:

    28

    Симпатии:

    1

    Адрес:

    Красноярск

15. 
    

    Форумчанин

    да за пределы видимой вам модели, вы сразу, перед тем как начать рисовать несколько раз сзумируйте в минус, просто видимое вам полемодели на компе, находится совсем в другом месте, от вашего участка

    #15

16. 
    

    Форумчанин

    Регистрация:

    31 окт 2009

    Сообщения:

    28

    Симпатии:

    1

    Адрес:

    Красноярск

    тоже не получается, все равно уходит за видимые пределы

    #16

17. 
    

    Форумчанин

18. 
    

    Форумчанин

    berdnikov, вы хоть отпишитесь, скачали ли, то что надо??

    #18

19. 
    

    Форумчанин

    Gero посмотрел твой фалик.Он развернут по отношению к первоисточнику.Это логично,в случае смены Х и У и исправление одной координаты.Но ведь координаты на снимке показаны и вне выделенного контура .Тогда что это? Что здесь первично и истинно-положение контура либо написание координат?

    #19

20. 
    

    Форумчанин

    Ну я собственно, сделал так, потому как ни я один заметил, что явно Х и У перепутанны (иначе просто какая-то фигня), ну а про 84 и 64 — это помоему и автор признал…
    Ждем ответов от автора!

    #20

• 
• Solo
• Восстановленный участник

• На форуме с 28 января 2007г.
• Сообщений: 12
• Спасибо: 0

Тема: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

Собственно вопрос в сабже. Перерыл весь форум, но подобного найти не смог. Если кто знает, помогите, пожалуйста. Нужна таблица с дирекционными углами, длинами линий между вершинами полигона (полилинии) и номеров пар точек. Как пронумеровать точки, вроде бы нашел лиспик, но если его приделать к этому, будет вообще замечательно.

• 
• Solo
• Восстановленный участник

• На форуме с 28 января 2007г.
• Сообщений: 12
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

Собственно, нужна таблица геоданных к выбранной полилинии

• 
• KAI
• Активный участник

• Откуда: Магадан
• На форуме с 19 января 2003г.
• Сообщений: 344
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

• 
• Solo
• Восстановленный участник

• На форуме с 28 января 2007г.
• Сообщений: 12
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

• Александр И
• Восстановленный участник

• На форуме с 29 января 2007г.
• Сообщений: 3
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

Попробуйте
CREDO DAT 3.0

• 
• Провинциал
• Восстановленный участник

• На форуме с 26 июля 2006г.
• Сообщений: 49
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

Уточните, для http://www.rybinsk-gis.narod.ru/sklad/zu.zip
Дирекционные углы: от какого направления считать, в каких единицах, какова размерность и пример записи..
Уж если пишем РУМБЫ, то напишем и УГЛЫ :о)
Главное, чтоб кому-то похорошело..

• 
• Solo
• Восстановленный участник

• На форуме с 28 января 2007г.
• Сообщений: 12
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

2 Провинциал — дирекционный угол — направление с севера по часовой стрелке
Единицы — градусы, минуты, секунды до целых секунд, если возможно с соответствующими символами, длины линий округляются до целых сантиметров. Таблица имеет такой вид:
номер  дирекционный   длина
точки     угол        линии
1
         326 45 12    15,12
2
…
n
         126 45 28    26,56
1

• 
• Ser
• Восстановленный участник

• На форуме с 1 декабря 2006г.
• Сообщений: 22
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

У меня есть полный комплекс по геодезии, в т.ч. и вывод таких таблиц. Однако он довольно объемный и взаимосвязанный, так что выдрать из него нужный кусок затруднительно. Где проживаете? Если недалеко, то мог бы передать лично при встрече с необходимыми иинструкциями (бесплатно). Отправлять по электронке — объем порядка 300 м, а диском по почте — лень.

• 
• Игорь Богаченко
• Активный участник

• Откуда: Украина / Ивано-Франковская /
• На форуме с 14 сентября 2005г.
• Сообщений: 429
• Спасибо: 2

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

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

• 
• juk
• Восстановленный участник

• На форуме с 25 марта 2003г.
• Сообщений: 153
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

Solo-посучись поговорим. 271388888

• 
• Solo
• Восстановленный участник

• На форуме с 28 января 2007г.
• Сообщений: 12
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

Спасибо всем, кто откликнулся!
Отдельное спасибо Игорю Богаченко!
Иду проверять почту…
>Ser — я живу в Краснодарском крае

• 
• juk
• Восстановленный участник

• На форуме с 25 марта 2003г.
• Сообщений: 153
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

извеняйте хотел сказать посТучись

• 
• Ser
• Восстановленный участник

• На форуме с 1 декабря 2006г.
• Сообщений: 22
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

> Solo
Далековато, я — в Средней полосе. Если интерес все-таки остался — см. в электронке.
С уважением

• 
• Ser
• Восстановленный участник

• На форуме с 1 декабря 2006г.
• Сообщений: 22
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

> Игорю
Богаченко
Очень хотелось бы посмотреть пакет отправленный Solo. Если есть возможность сбросьте пожалуйста и мне на электронку. Заранее благодарен.

• 
• Ser
• Восстановленный участник

• На форуме с 1 декабря 2006г.
• Сообщений: 22
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

> Игорю
Богаченко
Громаднейшее спасибо за быстрый и эффективный ответ. Правда пока не смотрел (выходной все-таки), но приятно. Успехов во всех начинаниях

• 
• master
• Восстановленный участник

• На форуме с 5 ноября 2005г.
• Сообщений: 3
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

> Игорь Богаченко
Большая просьба! Если есть такая возможность сборосьте мне на почту этот «пакет по земле устройству и геодезии» . Заранее спасибо!
У меня есть наработки по этому поводу сандартными методами но хотелось бы посмотреть что-то еще!

• 
• Solo
• Восстановленный участник

• На форуме с 28 января 2007г.
• Сообщений: 12
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

поделились програмкой, на аглицком акаде грят, работает, а на русифицированном 2006 не хочет. Может, кто из гуру подскажет, что не так?
(defun c:totbl (/
                *error*                 ; переопределеный обработчик ошибок
                vk_modes
                vk_moder
                vk_tru_text
                my_assoc                ; локализованные функции
                getpolylist
                lstptss
                gr->gms
                mixlists                ; локализованные функции
                mode1
                mode2
                mode3
                modeset
                modezer                 ; списки sysvars
                doc                     ; указатель на активный документ
                th                      ; высота текста
                ff                      ; указатель на выходной файл
                xls                     ; содержимое выходного файла
                txttbl                  ; текст таблицы
                gap                     ; смещение для отрисовки текста от сетки
                tmp                     ; временная переменная
                ptlz                    ; список точек зоны с именами
                pl                      ; полилиния
                ptlpl                   ; список вершин полилинии
                nptlz                   ; список вершин полилинии с именами точек
                flag                    ; флаг замкнутости
                dirangle                ; дирекционный угол
                disdir                  ; список дистанций и дирекционных углов
                ss                      ; набор заготовок таблицы
                tmppt                   ; точка за пределами видимости
                xt
                yt                      ; координаты точки tmppt
                x1
                x23
                x2
                x3
                x4
                x5                      ; X столбцов, полученные при разметке
                yt1
                yt2
                yt3
                yt4                     ; Y линий лаблицы
                yt                      ; текущее значение Y для построения таблицы
                bname                   ; имя блокатаблицы
                bsuff                   ; суффикс имени блока
                str                     ; строковая переменная
                oex                     ; VLA-объект приложение Excel
               )
  ;;—————————————————————————
  ;; обработка ошибок
  (defun *error* (msg /)
    (if (not (member msg ‘(«Function cancelled» «quit / exit abort» «завешить / выйти прервать»)))
      (princ (strcat «nЧто то не так!!! ERRNO = » (rtos (getvar «errno») 2 0) «. » msg))
    ) ;_  if
    (vla-endundomark doc)               ; завершим группу UNDO
    (vl-cmdf «_.u»)                     ; отмена сделанных изменений
    (princ)                             ; тихий выход
  ) ;_  defun
;;;————— Подпрограммы ——————
  ;;————————————————————————
  ;; запись в файл Excel
  (defun ac2xl (lst pod / fnt fnd wkbs awb mainsh cnm cell c r)
    (if (setq fnd (getfiled «Путь и имя нового файла» «» «xls» 9))
      (progn
        (if (and (setq fnt (findfile «areatable.xls»)) ;_ если найден файл шаблона
                 (findfile fnd) ;_ если есть файл с таким именем
                 (/= fnd fnt) ;_ ну разве кто-то может переписать или удалить шаблон?
                 (null (vl-file-delete fnd)) ;_ удаление существующего файла
            ) ;_  and
          (progn
            (alert (strcat «Файл «»
                           fnd
                           «» уже существует и имеет признак «только для чтения»,»
                           «nили не найден файл шаблона «table.xls».»
                           «nnВыполнение команды отменено.»
                   ) ;_  strcat
            ) ;_  alert
            (exit) ;_ аварийный выход при невозможности удаления файла
          ) ;_  progn
        ) ;_  if
        (if (and (null (findfile fnd)) ;_ и нет файла копии
                 (vl-file-copy fnt fnd) ;_ сделать копию файла с новым именем
            ) ;_  and
          (progn
            (setq oex (vlax-get-or-create-object «Excel.Application.10»)) ;_ Установить связь с Excel
            (if (null oex) ;_ Если связь не установлена, то аварийно завершить работу
              (progn (alert «Нельзя запустить Microsoft Excel») (exit))
            ) ;_ if
            (vlax-put-property oex «Visible» :vlax-true) ;_ сделать Excel видимым
            (setq wkbs (vlax-get-property oex «Workbooks»)) ; Указатель семейства Workbooks
            (setq awb (vlax-invoke-method wkbs «Open» fnd)) ; Открыть книгу и получить указатель книги
            (setq mainsh (vlax-get-property awb «ActiveSheet»)) ; Указатель на активный лист
            ;; запись списка в таблицу
            (setq r 4) ;_ строка
            (foreach n lst
              (setq c 1) ;_ колонка
              (foreach m n
                ;; номер ячейкм в формате A1
                (setq cnm (strcat (chr (+ 64 c)) (itoa r)))
                ;; получить указатель на ячейку
                (setq cell (vlax-variant-value (vlax-invoke-method mainsh «Evaluate» cnm)))
                (if (/= m «») ;_при наличии данных
                  ;; установить формат ячейки и записать данные
                  (if (< 1 c 5)
                    (progn
                      (vlax-put-property cell «NumberFormat» (vlax-make-variant «0,00» 8))
                      (vlax-put-property cell «Value2» (vlax-make-variant (atof m) 5))
                    ) ;_  progn
                    (progn
                      (vlax-put-property cell «NumberFormat» (vlax-make-variant «@» 8))
                      (vlax-put-property cell «HorizontalAlignment» (vlax-make-variant -4152 3))
                      (vlax-put-property cell «Value2» (vlax-make-variant (vl-string-subst «°» «%%d» m) 8))
                    ) ;_  progn
                  ) ;_  if
                ) ;_  if
                ;; отобразить границы ячейки
                (vlax-put-property (vlax-get-property cell «Borders») «LineStyle» (vlax-make-variant 1 3))
                (vlax-release-object cell) ;_ освободить ячейку
    (setq cell nil)
                (setq c (1+ c)) ;_ следующая колонка
              ) ;_  foreach
              (setq r (1+ r)) ;_ следующая строка
            ) ;_  foreach
            ;; подвальчик
            (setq cell (vlax-variant-value (vlax-invoke-method mainsh «Evaluate» (strcat «A» (itoa r)))))
            (vlax-put-property cell «Value2» (vlax-make-variant pod 8))
            (vlax-release-object cell) ;_ освободить ячейку
            (setq cell nil)
            (vlax-release-object mainsh) ;_ освободить лист
            (setq mainsh nil)
            (vlax-invoke-method awb «Close» :vlax-true) ; Закрыть книгу
            (vlax-release-object awb) ;_ освободить книгу
            (setq awb nil)
            (vlax-release-object wkbs) ;_ освободить семейство книг
            (setq wkbs nil)
            (vlax-invoke-method oex «Quit») ; отключиться и закрыть Excel
            (vlax-release-object oex) ;_ освободить Excel
            (setq oex nil)
          ) ;_  progn
          (alert (strcat «Файл шаблона не копируется или уже существует файл с именем «»
                         fnd
                         «» и признаком «только для чтения»!nnТаблица Excel не записана!»
                         «nnВыполнение команды отменено.»
                 ) ;_  strcat
          ) ;_  alert
        ) ;_  if
      ) ;_  progn
    ) ;_  if
  ) ;_  defun
  ;;————————————————————————
  ;; рекурсивная функция создания списка assoc со строками и числами
  ;; (my_assoc «3» ‘((«3» . «wer») (1 . 2) (3 . 4) (5 . 6) («3» . 7))) -> («wer» 7)
  ;; (my_assoc 3 ‘((3 . «wer») (1 . 2) (3 . 4) (5 . 6) («3» . 7))) -> («wer» 4)
  (defun my_assoc (el lst)
    (cond
      ((null lst) nil)                  ; список пуст — возврат nil
      ((equal (caar lst) el)            ; подходящее значение —
       (cons (cdar lst) (my_assoc el (cdr lst))) ; — тогда присоединим значение хвоста
      )
      (t (my_assoc el (cdr lst)))       ; не подходит — тогда вызов без присоединения значения хвоста
    ) ;_  cond
  ) ;_  defun
  ;;————————————————————————
  ;;————————————————————————
  ;; Функция создает список вершин полилинии
  ;; (GetPolyList имя_примитива) — возвращает список:
  ;;  ((список_вершин: (100 100 0) (200 100 0) …)
  ;;            флаг_замкнутости: T или NIL)
  (defun getpolylist (ent / lst c)
    (setq ent (entget ent))
    (cond
      ((= «LWPOLYLINE» (cdr (assoc 0 ent)))
       (list (mapcar ‘(lambda (x) (append x (list (cdr (assoc 38 ent))))) (my_assoc 10 ent))
             (= 1 (logand 1 (cdr (assoc 70 ent))))
       ) ;_  list
      )
      ((= «POLYLINE» (cdr (assoc 0 ent)))
       (setq c   (= 1 (logand 1 (cdr (assoc 70 ent))))
             ent (entnext (cdr (assoc -1 ent)))
       ) ;_  setq
       (while (progn (setq ent (entget ent)) (/= «SEQEND» (cdr (assoc 0 ent))))
         (if (= «VERTEX» (cdr (assoc 0 ent)))
           (setq lst (cons (cdr (assoc 10 ent)) lst))
         ) ;_  if
         (setq ent (entnext (cdr (assoc -1 ent))))
       ) ;_  while
       (list (reverse lst) c)
      )
    ) ;_  cond
  ) ;_  defun
  ;; конец функции создания списка вершин полилинии
  ;;—————————————————————————
  ;;—————————————————————————
  ;; рекурсивная функция возвращает список вида
  ;;  ((«значение_первого_аттрибута_блока» (3d координаты точки вставки блока))
  ;;   («значение_первого_аттрибута_следующего_блока» (3d координаты точки вставки блока))
  ;;   ……
  ;;  )
  ;; пример вызова (lstptss ss), где ss — selection set
  (defun lstptss (ss / el)
    (ssdel (setq el (ssname ss 0)) ss)  ; удалим el — первый объект из ss
    (cons (list (cdr (assoc 1 (entget (entnext el)))) ; значение аттрибута
                (cdr (assoc 10 (entget el))) ; координаты точки
          ) ;_  list
          (if (> (sslength ss) 0)       ; если есть еще объекты
            (lstptss ss)                ; то рекурсивный вызов
          ) ;_  if
    ) ;_  cons
  ) ;_  defun
  ;; ————-
  ;;—————————————————————————
  ;; сохранение системных переменных
  ;; возвращает список, состоящий из пар (имя_1 значение_1 имя_2 значение_2 ….)
  (defun vk_modes (listvar / ms) ;_ listvar — список системных переменных
    (foreach n listvar (setq ms (cons (getvar n) (cons n ms))))
    (reverse ms)
  ) ;_  defun
  ;;—————————————————————————
  ;; восстановление системных переменных
  (defun vk_moder (ms) ;_ ms — список, состоящий из пар (имя_1 значение_1 имя_2 значение_2 ….)
    (while ms (setvar (car ms) (cadr ms)) (setq ms (cddr ms))) ;_  while
  ) ;_  defun
  ;;——————————————————————————————
  ;;        *** Отрисовка строки текста ***
  ;; синтаксис (vk_tru_text текст точка_начала высота_текста угол_поворота опция_выравнивания)
  ;; при успешном выполнении возвращает новый примитив TEXT, при ошибке nil
  (defun vk_tru_text (txt t0 h ug just / elast)
    (setq elast (entlast))              ; последний созданный примитив
    (if (= (cdr (assoc 40 (tblsearch «STYLE» (getvar «TEXTSTYLE»)))) 0.0)
      (if (/= (strcase just) «L»)       ; при нулевой высота текста
        (vl-cmdf «_.TEXT» «_J» just t0 h ug txt)
        (vl-cmdf «_.TEXT» t0 h ug txt)
      ) ;_  if
      (if (/= (strcase just) «L»)       ; при фиксированнной высоте текста
        (vl-cmdf «_.TEXT» «_J» just t0 ug txt)
        (vl-cmdf «_.TEXT» t0 ug txt)
      ) ;_  if
    ) ;_  if
    (if (/= elast (entlast))
      (entlast)
      nil
    ) ;_  if
  ) ;_  defun vk_tru_text
  ;;        *** конец отрисовки строки текста ***
  ;;——————————————————————————————
  ;;——————————————————————————————
  ;; функция преобразования дес.градусы->строка вида «ггг%%d мм’ сс»»
  ;; аргумент — положительное число
  (defun gr->gms (a / g m s)
    (setq g (rtos (fix a) 2 0))
    (setq m (rtos (fix (* (setq a (- a (fix a))) 60)) 2 0))
    (setq s (rtos (fix (* (- (* a 60) (fix (* 60 a))) 60)) 2 0))
    (strcat g
            «%%d «
            (if (= (strlen m) 2)
              m
              (strcat «0» m)
            ) ;_  if
            «‘ «
            (if (= (strlen s) 2)
              s
              (strcat «0» s)
            ) ;_  if
            «»»
    ) ;_  strcat
  ) ;_  defun
  ;; конец функции преобразования дес.градусы->строка вида «ггг%%d мм’ сс»»
  ;;——————————————————————————————
  ;;——————————————————————————————
  ;; рекурсивная функция смешивания двух списков
  ;; (MIXLISTS ‘(1 2 3) ‘(4 5 6)) -> (1 4 2 5 3 6)
  ;; (MIXLISTS ‘(1 2 3 4) ‘(5 6 7)) -> (1 5 2 6 3 7 4)
  ;; (MIXLISTS ‘(1 2 3 4 5) ‘(6 7)) -> (1 6 2 7 3 nil 4 nil 5)
  ;; (MIXLISTS ‘(1 2 3) ‘(4 5 6 7)) -> (1 4 2 5 3 6 nil 7)
  (defun mixlists (lst1 lst2 /)
    (if (or lst1 lst2)
      (cons (car lst1) (mixlists lst2 (cdr lst1)))
      nil
    ) ;_  if
  ) ;_  defun
  ;;——————————————————————————————
  ;;==========================================================================================
  ;;        *** непосредственно программа ***
  (gc)
  (setq doc     (vla-get-activedocument (vlax-get-acad-object))
        ;; сохранение и установка переменных и высоты текста и т.д и т.п.
        mode1   (vk_modes ‘(«CMDECHO»
                            «BLIPMODE»
                            «LIMCHECK»
                            «UCSFOLLOW»
                            «CELTYPE»
                            «TEXTSTYLE»
                            «PICKFIRST»
                            «ATTREQ»
                            «ATTDIA»
                            «DIMZIN»
                           )
                ) ;_  vk_modes
        mode2   (vk_modes ‘(«ORTHOMODE» «OSMODE» «SNAPMODE»)) ; эти будут меняться часто
        mode3   (vk_modes ‘(«CECOLOR» «CLAYER» «CELWEIGHT»)) ; цвет, слой и толщина
        modezer ‘(«ORTHOMODE» 0 «OSMODE» 0 «SNAPMODE» 0)
        modeset (list «BLIPMODE»
                      0
                      «CMDECHO»
                      0
                      «LIMCHECK»
                      0
                      «UCSFOLLOW»
                      0
                      «CELTYPE»         ; тип линий «CONTINUOUS»
                      «CONTINUOUS»
                      «TEXTSTYLE»       ; стиль текста
                      (getvar «DIMTXSTY») ; как в стиле размера
                      «CECOLOR»         ; цвет
                      «BYLAYER»         ; BYLAYER
                      «CLAYER»          ; текущий слой «0»
                      «0»
                      «CELWEIGHT»       ; толщина линии ByLayer
                      -1
                      «PICKFIRST»       ; очистим текущий выбор
                      0
                      «ATTREQ»          ; требование ввода аттрибутов при вставке блока
                      1
                      «ATTDIA»          ; запрет окна диалога для ввода аттрибутов при вставке блока
                      0
                      «DIMZIN»          ; не обрезать хвостовые нули
                      0
                ) ;_  list
  ) ;_  setq
  ;;                     *** НАЧНЕМ ***
  (vla-startundomark doc)               ; начнем группу для отмены командой _.U
  ;; определим параметры
  (vk_moder modeset)                    ; установка переменных
  (vk_moder modezer)                    ; установка режимов отрисовки
  (setvar «tilemode» 0)                 ; переход в PARERSPACE
  (vl-cmdf «_.PSPACE»)                  ; переключаемся на PS
  (vl-cmdf «_.zoom» «_e»)               ; показать все
  (setvar «cvport» 1)                   ; текущий ВЭ
  (vl-cmdf «_.MSPACE»)                  ; переключаемся на MS
  ;; создание списка всех точек зоны
  (if (setq ptlz (ssget «_X» (list ‘(0 . «INSERT») ‘(410 . «Model») ‘(2 . «PZone»)))); только нужные блоки
    ;; проверка дубликатов точек зоны
    (progn
      (setq ptlz (lstptss ptlz))
      (setq tmp (mapcar ‘cadr ptlz))
      (while tmp
        (if (vl-position (car tmp) (cdr tmp))
          (progn
            (princ «n»)
            (princ (car tmp))
            (alert «Двойные точки в зоне объекта!nУдалите дубликаты и повторите вызов команды!»)
            (exit)
          ) ;_  progn
        ) ;_  if
        (setq tmp (cdr tmp))
      ) ;_  while
    ) ;_  progn
  ) ;_  if
  ;; полилиния и площадь
  (princ «nУкажите полилинию контура для создания таблицы»)
  (setq pl (ssname (ssget «_:E» ‘((0 . «*POLYLINE»))) 0)) ; выбор полилинии контура
  (vl-cmdf «_.area» «_o» pl)            ; вычислим площадь и периметр полилинии
  (setq pl (getpolylist pl))            ; список вершин и флаг
  (setq flag (cadr pl))                 ; флаг замкнутости
  (setq pl (car pl))                    ; список вершин полилинии
  ;; замкнутый контур надо гарантировать
  (cond
    ((and (not (equal (car pl) (last pl))) flag)
     (setq pl (append pl (list (car pl)))) ; если контур замкнут, добавим в конец первую точку
    )
    ((equal (car pl) (last pl)))        ; первая и последняя точки совпадают
    (t
     (alert «Контур не замкнут!»)
     (exit)
    )
  ) ;_  cond
  ;; идентификация номеров точек
  (foreach n pl
    (if (setq tmp (vl-position n (mapcar ‘cadr ptlz)))
      (setq nptlz (cons (nth tmp ptlz) nptlz)) ; в список вершину полилинии с именем точки
      (setq nptlz (cons (list «NoName» n) nptlz)) ; в список вершину полилинии без имени точки
    ) ;_  if
  ) ;_  foreach
  (setq tmp nptlz)                      ; вернем порядок следования
  ;; вычисление списка дистанций и дирекционных углов
  ;; с преобразованием в стрОки с начала строкИ таблицы
  (while (cadr tmp)
    (cond
      ((minusp (setq dirangle (- (* pi 1.5) (angle (cadar tmp) (cadadr tmp)))))
       (setq dirangle (+ pi pi dirangle))
      )
      ((>= dirangle (+ pi pi))
       (setq dirangle (- dirangle pi pi))
      )
    ) ;_  cond
    (setq disdir (cons
                   (list «»
                         «»
                         «»
                         (rtos (distance (cadar tmp) (cadadr tmp)) 2 2)
                         (gr->gms (* 180 (/ dirangle pi)))
                   ) ;_  list
                   disdir
                 ) ;_  cons
    ) ;_  setq
    (setq tmp (cdr tmp))
  ) ;_  while
  ;; преобразование номеров точек в стрОки с начала строкИ таблицы
  (setq tmp nil)
  (foreach n nptlz
    (setq tmp (cons                     ; в список вершину полилинии
                (list (car n)
;;;                      ;; полностью
;;;                      (rtos (cadadr n) 2 2)
                      ;; с обрезкой
                      (if (minusp (atof (setq str (rtos (cadadr n) 2 2))))
                        (if (> (strlen str) 7)
                          (strcat «-» (substr str (- (strlen str) 5) 6))
                          str
                        ) ;_  if
                        (if (> (strlen str) 6)
                          (substr str (- (strlen str) 5) 6)
                          str
                        ) ;_  if
                      ) ;_  if
;;;                      ;; полностью
;;;                      (rtos (caadr n) 2 2)
                      ;; с обрезкой
                      (if (minusp (atof (setq str (rtos (caadr n) 2 2))))
                        (if (> (strlen str) 7)
                          (strcat «-» (substr str (- (strlen str) 5) 6))
                          str
                        ) ;_  if
                        (if (> (strlen str) 6)
                          (substr str (- (strlen str) 5) 6)
                          str
                        ) ;_  if
                      ) ;_  if
                      «»
                      «»
                ) ;_  list
                tmp
              ) ;_  cons
    ) ;_  setq
  ) ;_  foreach
  ;; компоновка строк текста таблицы
  (setq txttbl (mixlists tmp disdir))
  (vl-cmdf «_.PSPACE»)                  ; переключаемся на PS
  ;; исходные данные для построения
  (setq th 2.5)                         ; высота текста в таблице
  (setq gap 1.8)                        ; отступ текста
  (setq temppt (list (setq xt (* (car (getvar «VSMAX»)) 2)) ; временная точка
                     (setq yt (* (cadr (getvar «VSMAX»)) 2)) ; за пределами видимости
               ) ;_  list
  ) ;_  setq
  ;; разметка таблицы по горизонтали самыми длинными TEXTами
  (setq x1 0.0)
  (foreach n (append ‘(«Номер» «точки») (mapcar ‘car tmp))
    ;; по наиболее длинному элементу первой колонки
    (setq x1 (max (+ xt gap gap (caadr (textbox (entget (vk_tru_text n ‘(0.0 0.0) th 0 «l»))))) x1))
    (entdel (entlast))
  ) ;_  foreach
  (setq x23 (+ gap
               gap
               (/ (caadr (textbox (entget (vk_tru_text «Координаты точек, м» ‘(0.0 0.0) th 0 «l»)))) 2.0)
            ) ;_  +
  ) ;_  setq
  (setq x2 (+ x1 x23))
  (setq x3 (+ x2 x23))
  (entdel (entlast))
  (setq x4 (+ x3 gap gap (caadr (textbox (entget (vk_tru_text «стороны, м» ‘(0.0 0.0) th 0 «l»))))))
  (entdel (entlast))
  (setq x5 (+ x4 gap gap (caadr (textbox (entget (vk_tru_text «Дирекционные» ‘(0.0 0.0) th 0 «l»))))))
  (entdel (entlast))
  ;; отрисовка заготовок таблицы
  ;; шапка таблицы
  (setq ss (ssadd))                     ; набор заготовок
  (setq yt (- yt gap th))               ; строка заголовка
  (vl-cmdf «_attdef»
           «»
           «TBLNAME»
           «Имя таблицы»
           «Ведомость вычисления площади земельного участка»
           (list (+ xt gap) yt)
           th
           0.0
  ) ;_  vl-cmdf
  (ssadd (entlast) ss)
  (vl-cmdf «_attdef» «» «ADD1» «Дополнительные данные 1» «» (list (+ xt gap) (- yt gap th)) th 0.0)
  (ssadd (entlast) ss)
  (vl-cmdf «_attdef»
           «»
           «ADD2»
           «Дополнительные данные 2»
           «»
           (list (+ xt gap) (- yt gap th gap th))
           th
           0.0
  ) ;_  vl-cmdf
  (ssadd (entlast) ss)
  (setq yt1 (- yt gap))                 ; верхняя граница
  (setq yt (- yt1 th gap))              ; первая строка шапки
  (ssadd (vk_tru_text «Номер» (list (/ (+ xt x1) 2.0) yt) th 0 «c») ss)
  (ssadd (vk_tru_text «Координаты точек, м» (list (/ (+ x1 x3) 2.0) yt) th 0 «c») ss)
  (ssadd (vk_tru_text «Длина» (list (/ (+ x3 x4) 2.0) yt) th 0 «c») ss)
  (ssadd (vk_tru_text «Дирекционные» (list (/ (+ x4 x5) 2.0) yt) th 0 «c») ss)
  (setq yt2 (- yt gap))                 ; линия в шапке
  (setq yt (- yt2 th gap))              ; вторая строка шапки
  (ssadd (vk_tru_text «точки» (list (/ (+ xt x1) 2.0) yt) th 0 «c») ss)
  (ssadd (vk_tru_text «X» (list (/ (+ x1 x2) 2.0) yt) th 0 «c») ss)
  (ssadd (vk_tru_text «Y» (list (/ (+ x2 x3) 2.0) yt) th 0 «c») ss)
  (ssadd (vk_tru_text «стороны, м» (list (/ (+ x3 x4) 2.0) yt) th 0 «c») ss)
  (ssadd (vk_tru_text «углы» (list (/ (+ x4 x5) 2.0) yt) th 0 «c») ss)
  (setq yt3 (- yt gap))                 ; линия между шапкой и телом
  (setq yt (- yt3 th gap))              ; первая строка тела таблицы
  ;; тело таблицы
  (foreach n txttbl
    (mapcar ‘(lambda (txt x) (ssadd (vk_tru_text txt (list (- x gap) yt) th 0 «r») ss))
            n
            (list x1 x2 x3 x4 x5)
    ) ;_  mapcar
    (setq yt (- yt gap th))             ; следующая строка тела таблицы
  ) ;_  foreach
  (setq yt4 (+ yt th))                  ; линия между телом и подвалом
  ;; подвальчик
  (ssadd (vk_tru_text
           (setq str (strcat «Площадь участка «
                             (rtos (getvar «area») 2 0)
                             » кв. м. Периметр «
                             (rtos (getvar «perimeter») 2 0)
                             «м.»
                     ) ;_  strcat
           ) ;_  setq
           (list (+ xt gap) (- yt gap))
           th
           0
           «l»
         ) ;_  vk_tru_text
         ss
  ) ;_  ssadd
  ;; сетка
  (mapcar ‘(lambda (sx sy ex ey)
             (vl-cmdf «_.line» (list sx sy) (list ex ey) «»)
             (ssadd (entlast) ss)
           ) ;_  lambda
          (list xt x1 xt xt xt x1 x2 x3 x4 x5)
          (list yt1 yt2 yt3 yt4 yt1 yt1 yt2 yt1 yt1 yt1)
          (list x5 x3 x5 x5 xt x1 x2 x3 x4 x5)
          (list yt1 yt2 yt3 yt4 yt4 yt4 yt4 yt4 yt4 yt4)
  ) ;_  mapcar
  ;; создание и вставка блока таблицы
  (setq bsuff 0)                        ; исходное значение суффикса
  (ssget «_X» ‘((0 . «INSERT») (2 . «areatable*»)))
  (vl-cmdf «_purge» «_b» «areatable*» «_n») ; удаление из БД неиспользуемых блоков таблиц
  (while (tblsearch «BLOCK» (setq bname (strcat «areatable» (rtos bsuff 2 0))))
    (setq bsuff (1+ bsuff))             ; вычисление суффикса для уникального имени блока
  ) ;_  while
  (vl-cmdf «_block» bname temppt ss «») ; создание нового блока таблицы
  (vk_moder mode2)                      ; восстановим привязки
  ;; вставка блока таблицы с значениями атрибутов по умолчанию
  (vl-cmdf «_insert» bname pause 1.0 1.0 0.0 «» «» «»)
  ;; запись текста таблицы в файл Excel
  (ac2xl txttbl str)
  (vk_moder mode1)                      ; восстановление переменных
  (vk_moder mode3)                      ; и других переменных
  (redraw)
  (vla-endundomark doc)                 ; завершим группу UNDO
  (gc)
  (princ)
  ;;        ***  конец непосредственно программы ***
  ;;==========================================================================================
) ;_  defun
(vl-load-com)
(princ «nДля запуска с командной строки: totbl»)
(princ)

• 
• Solo
• Восстановленный участник

• На форуме с 28 января 2007г.
• Сообщений: 12
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

таблицу в Экселе делает, но:
1. Работает только в пространстве листа, то есть координаты совсем не те;
2. Длины линий и координаты почему-то форматируются в 100 раз меньше, но это исправляется свойствами ячейки;
3. дирекционные углы правильные, но саму таблицу в Акаде не строит, делает только 3 атрибута и текст с нулями

• 
• kpblc
• Активный участник

• Откуда: С.-Петербург
• На форуме с 29 ноября 2004г.
• Сообщений: 8,348
• Спасибо: 23

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

   (setvar "tilemode" 0) ; переход в PARERSPACE
  (vl-cmdf "_.PSPACE") ; переключаемся на PS
  (vl-cmdf "_.zoom" "_e") ; показать все
  (setvar "cvport" 1) ; текущий ВЭ
  (vl-cmdf "_.MSPACE") ; переключаемся на MS

• 
• Alan
• Активный участник

• Откуда: Украина / Киев
• На форуме с 2 апреля 2002г.
• Сообщений: 1,345
• Спасибо: 15

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

;;------------------------------------------------------------------------------------------
;; *** Отрисовка строки текста ***
;; синтаксис (vk_tru_text текст точка_начала высота_текста угол_поворота опция_выравнивания)
;; при успешном выполнении возвращает новый примитив TEXT, при ошибке nil
(defun vk_tru_text (txt t0 h ug just / elast)
(setq elast (entlast)) ; последний созданный примитив
(if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0)
(if (/= (strcase just) "L") ; при нулевой высота текста
(vl-cmdf "_.TEXT" "_J" just t0 h ug txt)
(vl-cmdf "_.TEXT" t0 h ug txt)
) ;_ if
(if (/= (strcase just) "L") ; при фиксированнной высоте текста
(vl-cmdf "_.TEXT" "_J" just t0 ug txt)
(vl-cmdf "_.TEXT" t0 ug txt)
) ;_ if
) ;_ if
(if (/= elast (entlast))
(entlast)
nil
) ;_ if
) ;_ defun vk_tru_text
;; *** конец отрисовки строки текста ***
;;------------------------------------------------------------------------------------------

• 
• Alan
• Активный участник

• Откуда: Украина / Киев
• На форуме с 2 апреля 2002г.
• Сообщений: 1,345
• Спасибо: 15

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

опцию «L» команды «_.TEXT»

• 
• Solo
• Восстановленный участник

• На форуме с 28 января 2007г.
• Сообщений: 12
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

вообще-то эксел мне не нужен, просто он был в исходном лиспе

• 
• Андрей
• Восстановленный участник

• На форуме с 4 марта 2007г.
• Сообщений: 2
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

Господа Землеустроители поделитесь пожалуста
комплексами «Зем» под А-кад.
В долгу не останусь
Андрей Сергеевич
г.Одесса
ОРФ ДП ЦДЗК

• 
• Demon
• Восстановленный участник

• На форуме с 1 апреля 2007г.
• Сообщений: 5
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

> Ser
Привет, занимаюсь геодезией 3 ий год. Очень заинтересовало какой у тебя софт. Давай поделимся наработками. с уважением Дмитрий.

• 
• Demon
• Восстановленный участник

• На форуме с 1 апреля 2007г.
• Сообщений: 5
• Спасибо: 0

Re: Help!!! помогите по полилинии таблица дирекционных углов, длин линий и номеров точек

> Игорь Богаченко
Поделитесь информацией, что у вас за пакет по по геодезии. Работаю в этой отрасли 3 ий год. Заранее
спасибо.
Дмитрий.