[G-RAV]

Написал код для импорта точек .job или .are в Автокад минуя Кредо_Дат, полученных по результатам геодезической съемки прибором Trimble Geodimetr 600. С условием, что съемка велась от исходных пунктов с известными координатами ( в приборе). Буду рад полезной критике, т.к. только начинаю программировать.

Код:

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

 
(defun import_job&are (/)
; отключаем вывод сообщений в командную строку
(setvar "cmdecho" 0)
;;Запоминание привязки, и текущего слоя и цвета
(setq AAA (getvar "osmode"))
;выбираем файл присваеваем File
(setq File (getfiled "Выберите файл с расширением job & are для загрузки в Autocad"  (getvar "dwgprefix") "job;are" 8)) 
;вывод сообщения "Идет работа"
(print "Идет работа")
;поиск файла File присваеваем f
(setq f(findfile File))
;открываем f для чтения
(setq f(open f "r"))
;считываем первую строку Stroka файла f
(setq Stroka(read-line f))
;Начало цикла While до пустой строки
(While(/= Stroka nil)
  ;Начало подцикла While до "0=Measured point" или ">"
  (While(and(/= Stroka "0=Measured point")
 (/= Stroka ">"))
    ;условие на "15=" ищем имя для слоя (на текущей строке)
    (if(=(substr Stroka 1 3) "15=")
  (setq name (substr Stroka 4)))
      ;условие на "5=" ищем имя точки (на текущей строке)
      (if(=(substr Stroka 1 2) "5=")
  (setq a1 (substr Stroka 3)))
      ;условие на "2=" ищем имя точки стояния (на текущей строке)
  (if(=(substr Stroka 1 2) "2=")
  (setq a1 (substr Stroka 3)))
      ;условие на "62=" ищем имя точки ориентирования (на текущей строке)
  (if(=(substr Stroka 1 3) "62=")
  (setq a1 (substr Stroka 4)))
  ;условие на "37=" ищем координату Х точки (на текущей строке)  
  (if (=(substr Stroka 1 3) "37=")
  (setq a3 (substr Stroka 4)))
  ;условие на "38=" ищем координату У точки (на текущей строке)  
  (if (=(substr Stroka 1 3) "38=")
 (setq a4 (substr Stroka 4)))
  ;условие на "39=" ищем высоту точки (на текущей строке)  
  (if(=(substr Stroka 1 3) "39=")
   (setq a5 (substr Stroka 4)))
    ;переход на следующую строку
    (setq Stroka(read-line f))
  );Конец подцикла While до "0=Measured point" или ">"
 
;Ряд операций по отрисовки точек
(progn
(command"_layer""_m" name "") ;Устанавливаем текущем и Рисуем в слое name
  (setq Npiketa a1);Присваеваем Npiketa значение a1
  (setq XYmat (list (atof a4)(atof a3)));Преобразуем в вещественные и объеденяем в список координаты
          (setq Otmetka (rtos(atof a5)2 2));Преобразуем в вещественное и округляем до десятых значение Otmetka
(if(= Otmetka "0.00") (setq Otmetka "Б/В"));Если значение Otmetka=0.00 то заменяем его на Б/В
(command"_osnap" "_non")
(command"_insert" "piket_s"  XYmat 1 1 0 Npiketa Otmetka "" "");вставка блока piket_s
    );Конец операций по отрисовки точек
(setq Stroka(read-line f));переход на следующую строку
(setq a1 "" a3 "" a4 "" a5 "");обнуление аргуменов
 ) ;Конец цикла While до пустой строки
(close f);Закрытие файла
(command "_zoom" "_E" );Показать видимые элементы чертежа
(setvar "osmode" AAA);;Восстановление привязки, и текущего слоя  
(alert "Загрузка закончена")
  )
(import_job&are)

И помогите, кто может, создать DCL. Где можно было бы выставлять точность отметки (Н), задавать имя слоя (имя, заданное при съемке ("15=" по умолчанию), и самое главное выбирать цвет слоя из палитры, можно еще и шкалу прогресса, но не так уж важно как остальное.

P.S. Прикрепляю Рисунок.dwg, содержащий необходимый блок
И архив со съемочным файлом

[Do$]

Почему-то у меня открывается пустой чертеж по 2-й ссылке...

[Victor]

Это в новых автокадах атрибуты задаются в command?. У меня 2008 говорит неизвесная команда.

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

У автора, похоже, изменена attdia...

[G-RAV]

Сам чертеж пустой, но содержит блок "piket_s" (можно увидеть в редакторе блоков), который состоит из точки и 4-х атрибутов(NN-номер, H_FAKT-фактическая отметка, delta_H - превышение факта от проекта, H_PROEKT - проектная отметка. На счет 2008-го не знаю, потому как делал все в 6-м...

[Victor]

Мне просто любопытно. Без строки (setvar "attreq" 0) запрашивает атрибут. Со строкой - неизвесная команда.

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

Victor, attreq и attdia немного разные вещи.

[G-RAV]

вообще не понимаю о чем вы! В работе, руководствуюсь литературой Николая Полещука, там я не нашел в системных переменных attreq и attdia. У кого-нить кроме меня вообще работает??

[Victor]

Заработало. Когда установил (setvar "attdia" 0). Только точка вставки блока странная. Может только у меня

[G-RAV]

Сообщение от Victor Заработало. Когда установил (setvar "attdia" 0). Только точка вставки блока странная. Может только у меня

А что именно странного?
Вкладываю рисунок.dwg - то что должно получится..

[Victor]

Точка вставки блока где-то в стороне от блока.

[Do$]

ага, есть такое

[G-RAV]

Поставил себе 2008-й.. Все работает.. И точки вставляются в соответствии с координатами в файле..

[Do$]

Господа, позвольте мне, в целях повышения уровня собственной образованности если не прав - пинайте

Код:

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

(defun import_job&are (/) 
;_можно название поменять на C:import_job&are, чтоб запускать командой 
;_неплохо было б указать локальные переменные после /
; отключаем вывод сообщений в командную строку
(setvar "cmdecho" 0)
;_если уж совсем по правильному, то исходное значение "cmdecho" тоже 
;_надо сохранять и потом восстанавливать 
;;Запоминание привязки, и текущего слоя и цвета
(setq AAA (getvar "osmode"))
;выбираем файл присваеваем File
(setq File (getfiled "Выберите файл с расширением job & are для загрузки в Autocad"  (getvar "dwgprefix") "job;are" 8)) 
;вывод сообщения "Идет работа"
(print "Идет работа")
;поиск файла File присваеваем f
(setq f(findfile File)) ;_а зачем его искать? мы ж его указываем.
;открываем f для чтения
(setq f(open f "r"))
;считываем первую строку Stroka файла f
(setq Stroka(read-line f))
;Начало цикла While до пустой строки
;_насчет прогресс-бара, благодаря Александру Ривилису есть такая возможность
;_но не уверен, что с циклом при помощи while можно его использовать
(While(/= Stroka nil)
  ;Начало подцикла While до "0=Measured point" или ">"
  (While(and(/= Stroka "0=Measured point")
 (/= Stroka ">"))
;_а далее вместо кучи if можно использовать cond
    ;условие на "15=" ищем имя для слоя (на текущей строке)
    (if(=(substr Stroka 1 3) "15=")
  (setq name (substr Stroka 4)))
      ;условие на "5=" ищем имя точки (на текущей строке)
      (if(=(substr Stroka 1 2) "5=")
  (setq a1 (substr Stroka 3)))
      ;условие на "2=" ищем имя точки стояния (на текущей строке)
  (if(=(substr Stroka 1 2) "2=")
  (setq a1 (substr Stroka 3)))
      ;условие на "62=" ищем имя точки ориентирования (на текущей строке)
  (if(=(substr Stroka 1 3) "62=")
  (setq a1 (substr Stroka 4)))
  ;условие на "37=" ищем координату Х точки (на текущей строке)  
  (if (=(substr Stroka 1 3) "37=")
  (setq a3 (substr Stroka 4)))
  ;условие на "38=" ищем координату У точки (на текущей строке)  
  (if (=(substr Stroka 1 3) "38=")
 (setq a4 (substr Stroka 4)))
  ;условие на "39=" ищем высоту точки (на текущей строке)  
  (if(=(substr Stroka 1 3) "39=")
   (setq a5 (substr Stroka 4)))
    ;переход на следующую строку
    (setq Stroka(read-line f))
  );Конец подцикла While до "0=Measured point" или ">"
 
;Ряд операций по отрисовке :) точек
(progn
(command"_layer""_m" name "") ;Устанавливаем текущем и Рисуем в слое name
  (setq Npiketa a1);Присваеваем Npiketa значение a1
;_от переменной Npiketa можно избавиться, сразу передавать в command a1 
  (setq XYmat (list (atof a4)(atof a3)));Преобразуем в вещественные и объеденяем в список координаты
;_список тоже можно сразу загнать в command минуя сохранение в переменной
          (setq Otmetka (rtos(atof a5)2 2));Преобразуем в вещественное и округляем до десятых значение Otmetka
(if(= Otmetka "0.00") (setq Otmetka "Б/В"));Если значение Otmetka=0.00 то заменяем его на Б/В
;_от переменной Otmetka тоже можно избавиться...
(command"_osnap" "_non")
(command"_insert" "piket_s"  XYmat 1 1 0 Npiketa Otmetka "" "");вставка блока piket_s
    );Конец операций по отрисовке точек
(setq Stroka(read-line f));переход на следующую строку
(setq a1 "" a3 "" a4 "" a5 "");обнуление аргуменов
 ) ;Конец цикла While до пустой строки
(close f);Закрытие файла
(command "_zoom" "_E" );Показать видимые элементы чертежа
(setvar "osmode" AAA);;Восстановление привязки, и текущего слоя  
(alert "Загрузка закончена")
  )
(import_job&are)

Это по оформлению в основном... А так, если работает - то хорошо
DCL могу накидать, если нарисуешь как он должен выглядеть и поподробнее расскажешь что требуется от диалога.
А цвет можно выбрать из лиспа прямо, без DCL (ф-ция acad_colordlg например.)

[G-RAV]

Наконец-то я дождался хоть какой то критики.. Спасибо, Do$! У меня еще ко всему прочему и с русским языком проблемы.. И точка вставки действительно где-то в стороне, и не могу понять почему... А код попробую поправить и выложу...

[Do$]

Сообщение от G-RAV И точка вставки действительно где-то в стороне, и не могу понять почему...

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

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

Добавлю: нет обработчика ошибок; чтение файла выполняется вместе с рисованием (что в принципе лично я не считаю нормальным решением: желательно сначала прочитать файл, преобразовать данные с список и потом уже выполнять вставку блоков). Ну и плюс добавить обработку системных переменных attdia, attreq.

[G-RAV]

Вроде бы поправил, правда не все:

Код:

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

 
(defun C:import_job&are (/ f Stroka name a1 a3 a4 a5) 
;_можно название поменять на C:import_job&are, чтоб запускать командой 
;_неплохо было б указать локальные переменные после / сделал
; отключаем вывод сообщений в командную строку
(setq BBB (getvar "cmdecho"))
(setvar "cmdecho" 0)
;_если уж совсем по правильному, то исходное значение "cmdecho" тоже 
;_надо сохранять и потом восстанавливать сделал
;;Запоминание привязки, и текущего слоя и цвета
(setq AAA (getvar "osmode"))
;выбираем файл присваеваем File
(setq File (getfiled "Выберите файл с расширением job & are для загрузки в Autocad"
       (getvar "dwgprefix") "job;are" 8)) 
;вывод сообщения "Идет работа"
(print "Идет работа")
;поиск файла File присваеваем f
(setq f(findfile File)) ;_а зачем его искать? мы ж его указываем.
   ; в противном случае ошибка: неверный тип аргумента: FILE nil
;открываем f для чтения
(setq f(open f "r"))
;считываем первую строку Stroka файла f
(setq Stroka(read-line f))
;Начало цикла While до пустой строки
;_насчет прогресс-бара, благодаря Александру Ривилису есть такая возможность
;_но не уверен, что с циклом при помощи while можно его использовать
(While(/= Stroka nil)
  ;Начало подцикла While до "0=Measured point" или ">"
  (While(and(/= Stroka "0=Measured point")
 (/= Stroka ">"))
;_а далее вместо кучи if можно использовать cond сделал
    ;условие на "15=" ищем имя для слоя (на текущей строке)
    (cond((=(substr Stroka 1 3) "15=")
  (setq name (substr Stroka 4)))
      ;условие на "5=" ищем имя точки (на текущей строке)
  ((=(substr Stroka 1 2) "5=")
  (setq a1 (substr Stroka 3)))
      ;условие на "2=" ищем имя точки стояния (на текущей строке)
  ((=(substr Stroka 1 2) "2=")
  (setq a1 (substr Stroka 3)))
      ;условие на "62=" ищем имя точки ориентирования (на текущей строке)
  ((=(substr Stroka 1 3) "62=")
  (setq a1 (substr Stroka 4)))
  ;условие на "37=" ищем координату Х точки (на текущей строке)  
  ((=(substr Stroka 1 3) "37=")
  (setq a3 (substr Stroka 4)))
  ;условие на "38=" ищем координату У точки (на текущей строке)  
  ((=(substr Stroka 1 3) "38=")
 (setq a4 (substr Stroka 4)))
  ;условие на "39=" ищем высоту точки (на текущей строке)  
  ((=(substr Stroka 1 3) "39=")
   (setq a5 (substr Stroka 4))))
    ;переход на следующую строку
    (setq Stroka(read-line f))
  );Конец подцикла While до "0=Measured point" или ">"
 
;Ряд операций по отрисовке :) точек
(progn
(command"_layer""_m" name "") ;Устанавливаем текущем и Рисуем в слое name
;_от переменной Npiketa можно избавиться, сразу передавать в command a1 - сделал
;_список тоже можно сразу загнать в command минуя сохранение в переменной - сделал
(setq Otmetka (rtos(atof a5)2 2));Преобразуем в вещественное и округляем до десятых значение Otmetka
(if(= Otmetka "0.00") (setq Otmetka "Б/В"));Если значение Otmetka=0.00 то заменяем его на Б/В
;_от переменной Otmetka тоже можно избавиться...
; а как? на нее же условие??
(command"_osnap" "_non")
(command"_insert" "piket_s"  (list (atof a4)(atof a3)) 1 1 0 a1 Otmetka "" "");вставка блока piket_s
    );Конец операций по отрисовке точек
(setq Stroka(read-line f));переход на следующую строку
(setq a1 "" a3 "" a4 "" a5 "");обнуление аргуменов
 ) ;Конец цикла While до пустой строки
(close f);Закрытие файла
(command "_zoom" "_E" );Показать видимые элементы чертежа
(setvar "osmode" AAA);;Восстановление привязки, и текущего слоя
(setvar "cmdecho" BBB)  
(alert "Загрузка закончена")
)

На счет обработчика ошибок и системных переменных attdia, attreq вообще не секу, если можно по-подробнее, буду очень признателен.

[Do$]

Как-то так можно:

Код:

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

(setq  
  f
    (open
      (setq
	file
	 (getfiled
	   "Выберите файл с расширением job & are для загрузки в Autocad"
	   (getvar "dwgprefix")
	   "job;are"
	   8
	 ) ;_ end of getfiled
      ) ;_ end of setq
      "r"
    ) ;_ end of open
) ;_ end of setq

И вот так:

Код:

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

(command
  "_insert"
  "piket_s"
  (list (atof a4)(atof a3))
  1
  1
  0
  a1
  (if (= (rtos (atof a5) 2 2) "0.00")
    "Б/В"
    (rtos (atof a5) 2 2)
  ) ;_ end of if
  ""
  ""
) ;_ end of command

Насчет системных переменных:
http://www.autocads.ru/prilosh/pril_3.php

[G-RAV]

Вот как-то так я представляю себе диалоговое окно (прада, можно и как-нить компактней):

Код:

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

 
import: // наверное уже после выбора файла
dialog{label="Импорт точек .job & .are";
:edit_box{label="Имя слоя для пикетов";key="name_layer";value="";edit_width=6;} // по умолчанию, то что стоит после 15= в файле.job
:edit_box{label="Точность Н(знаков после точки)";key="TCH_H";value="";edit_width=6;}
:row{fixed_width=true;alignment=centered;
  :button{label="Палитра";key="palitra";} // интерисует именно цвет слоя 
  :button{label="Импорт";key="Import";}
  :ok_button{label="Выход";is_cancel=true;}
}//row
:row{
  :image{width=20;height=0.5;key="img";} // шкала прогресса
  }//row
}