Форум для строителей и проектировщиков - Типовые серии, Типовые проекты, сметы, СНиПы, ГОСТы, NormaCS, NormCAD   Строительный сайт
Сайт для строителей Скорая 

помощь+Обсуждение программ Каталог Электроных книг Игры / Games Всё для строителей Бизнес софт : СПС Загадочное и неизведанное
Наш сайт! Скорая помощь Библиотека Игры Всё для строителей СПС Загадочное
Вернуться   Форум для строителей и проектировщиков - Типовые серии, Типовые проекты, сметы, СНиПы, ГОСТы, NormaCS, NormCAD > Всё для строителей: проектирование, типовые серии и проекты > Проектирование и Расчет > Autodesk (обсуждение)

Важная информация

Autodesk (обсуждение) Своевременное решение проблем и интерактивное обсуждение проб и ошибок с продуктами Autodesk

Ответ
 
Опции темы
Старый 16.06.2009, 20:47   #1
Guest
По умолчанию

LISPы для геодезии

Я геодезист, и этот лисп мне серьезно упрощает работу:
;|=============== Команда COORN ===============================================
EN:
Export of coordinates of the specified points, the chosen objects: points, blocks, polylines, splines in a text file, Excel.
Text file — txt, or csv. A rounding off of coordinates according to current adjustments of a command _UNITS (LUPREC !!!)
RUS:
Экспорт координат указанных точек, выбранных объектов: точек, блоков, полилиний, сплайнов в текстовый файл, ексел с простановкой номеров
Текстовый файл — либо txt, либо csv.
Номера точек отрисовываются текстом на текущем слое, текущим стилем, текущей высотой
Округление координат в соответствии с текущими настройками команды _UNITS (переменная LUPREC !!!)
|;
(defun c:COORN (/ cFile curPt filPath objSet oFlag oldMode ptLst sFlag lw isRus Npt)
(defun group-by-num (lst num / ls ret)(if (= (rem (length lst) num ) 0)(progn (setq ls nil)
(repeat (/ (length lst) num)(repeat num (setq ls(cons (car lst) ls)lst (cdr lst)))
(setq ret (append ret (list (reverse ls))) ls nil)))) ret)
(defun PtCollect(SelSet)(mapcar 'cdr (mapcar '(lambda(x)(assoc 10 x))(mapcar 'entget
(vl-remove-if 'listp(mapcar 'cadr(ssnamex SelSet))))))); end of PtCollect
(defun PLCollect(SelSet / ret)
(foreach lw (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp(mapcar 'cadr(ssnamex SelSet))))
(cond ((wcmatch (vla-get-ObjectName lw) "*Polyline")
(setq ret (append ret (group-by-num (vlax-get lw 'Coordinates)
(if (=(vla-get-ObjectName lw) "AcDbPolyline") 2 3)))))
((=(vla-get-ObjectName lw) "AcDbSpline")(setq ret (append ret (group-by-num
(vlax-safearray->list(vlax-variant-value (vla-get-controlpoints lw))) 3))))
(t nil))) ret)
(vl-load-com)(setq isRus(= (getvar "SysCodePage") "ANSI_1251"))(if(not ptcol:mode)(setq ptcol:mode "Pick"))
(initget "Указать Точка Блоки Полилиния Pick pOints Blocks poLyline _Pick pOints Blocks poLyline Pick pOints Blocks poLyline")
(setq oldMode ptcol:mode ptcol:mode
(getkword (if IsRus (strcat "\nВыберите режим [Указать/Точка/Блоки/Полилиния или сплайн] <"
(cadr (assoc ptcol:mode '(("Pick" "Указать")("pOints" "Указать")("Blocks" "Блоки")("poLyline" "Полилиния")))) ">: ")
(strcat "\nSpecify mode [Pick/pOints/Blocks/poLyline or spline] <"ptcol:mode">: "))) ptLst nil)
(if(null ptcol:mode)(setq ptcol:mode oldMode))
(cond ((= "Pick" ptcol:mode)(setq curPt T)
(while curPt (setq curPt(getpoint (if IsRus
"\nУкажите точку или Enter завершения > " "\nPick point or Enter to continue > ")))
(if curPt (setq ptLst(append ptLst(list (trans curPt 1 0))))))); end condition #1
((= "pOints" ptcol:mode)(if (not(setq objSet(ssget "_I" '((0 . "POINT")))))(progn
(if IsRus (princ "\nВыберите точки и нажмите Enter ")(princ "\nSelect points and press Enter "))
(setq objSet(ssget '((0 . "POINT"))))))(if objSet (setq ptLst(PtCollect objSet)))); end condition #2
((= "Blocks" ptcol:mode)(if (not(setq objSet(ssget "_I" '((0 . "INSERT")))))(progn
(if IsRus(princ "\nВыберите блоки и нажмите Enter ")(princ "\nSelect blocks and press Enter "))
(setq objSet(ssget '((0 . "INSERT"))))))(if objSet (setq ptLst(PtCollect objSet)))); end condition #3
((= "poLyline" ptcol:mode)(if (not(setq objSet(ssget "_I" '((0 . "*POLYLINE,SPLINE")))))(progn
(if IsRus(princ "\nВыберите полилинии и нажмите Enter ")(princ "\nSelect polyline and press Enter "))
(setq objSet(ssget '((0 . "*POLYLINE,SPLINE"))))))(if objSet (setq ptLst(PLCollect objSet)))); end condition #4
); end cond
(if ptLst (progn (princ "\n+++++++ Coordinates list +++++++\n")(setq ptLst (mapcar '(lambda(x)(trans x 0 1)) ptLst))
(mapcar '(lambda(x)(princ(strcat "\n"(rtos(car x))","(rtos(cadr x))
(if(= 3(length x))(strcat ","(rtos(nth 2 x))) "")))) ptLst); end mapcar
(princ "\n\n+++++++++ End of list +++++++++")
(setq Npt (getint (if IsRus "\nНачальный номер точки <Не маркировать> : " "\nStart number of points <Don't mark> : " )))
(initget "Файл Excel Не Text Excel Not _Text Excel Not Text Excel Not")
(setq sFlag (getkword (if IsRus "\nСохранить координаты в [Файл/Excel/Не сохранять] <Файл> : "
"\nSave coordinates to [Text file/Excel/Not save] <Text> : ")))
(if(null sFlag)(setq sFlag "Text"))(setq oFlag Npt)(if (numberp Npt)
(foreach ln ptlst
(text-draw ;_Отрисовка текста
(itoa Npt) ;_Номер точки
(polar ln (/ pi 4) 1.) ;_Координаты на 1 ед по углом 45 градусов
(getvar "TEXTSIZE") ;_ Текущей высотой текста
0 ;_Угол поворота
nil
)
(setq Npt (1+ Npt))))
(setq Npt oFlag)
(setq ptLst (mapcar '(lambda(x)(mapcar 'rtos x)) ptlst))
(cond ((and (= "Text" sFlag)(setq filPath
(getfiled (if IsRus "Сохранение координат в текстовый файл" "Save Coordinates to Text File") "Coordinates.txt" "txt;csv" 33)))
(setq cFile(open filPath "w"))(foreach ln ptLst (write-line (strcat (if (numberp Npt)(strcat (itoa Npt) ",") "")(car ln)","(cadr ln)
(if(= 3(length ln))(strcat ","(nth 2 ln)))) cFile)(if (numberp Npt)(setq Npt (1+ Npt))))(close cFile)(initget "Yes No")
(setq oFlag(getkword (if IsRus "\nОткрыть файл? [Yes/No] <No> : " "\nOpen text file? [Yes/No] <No> : " )))
(if(= oFlag "Yes")(startapp "notepad.exe" filPath))); end condition #1
((= "Excel" sFlag)(if (numberp Npt)(progn
(setq ptlst (mapcar '(lambda(x)(cons (1- (setq Npt (1+ Npt))) x)) ptlst))
(xls ptlst '("N" "X" "Y" "Z") nil "COORN"))
(xls ptLst nil nil "COOR"))); end condition #2
(t nil)))) (princ)); end of c:COOR
;|================== XLS ========================================
* published http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31371zf
http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31596eW
* Purpose: Export of the list of data Data-list in Excell
* It is exported to a new leaf of the current book.
If the book is not present, it is created
* Arguments:
Data-list — The list of lists of data (LIST)
((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
Each list of a kind (Value1 Value2... VlalueN) enters the name in
a separate line in corresponding columns (Value1-A Value2-B and .т.д.)
header — The list (LIST) headings or nil a kind (" Signature A " " Signature B "...)
If header nil, is accepted ("X" "Y" "Z")
Colhide — The list of alphabetic names of columns to hide or nil — to not hide ("A" "C" "D") — to hide columns A, C, D
Name_list — The name of a new leaf of the active book or nil — is not present
* Return: nil
* Usage
(xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Col1" "Col2" "Col3" "Col4") '("B") "test") |;

;|================== XLS ========================================
* Опубликовано http://www.autocad.ru/cgi-bin/f1/boa...19833nl&page=2
http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31371zf
http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31596eW
* Автор: Владимир Азарко aka VVA
* Назначение: Печать списка данных Data-list в Excell
* Для вывода создается новая книга
Вывод осуществляется в первом листе
* Аргументы:
Data-list — список списков данных (LIST) вида
((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
Каждый список вида (Value1 Value2 ... VlalueN) записывается
в отдельную строку в соответствующие столбцы (Value1-A Value2-B и .т.д.)
header — список (LIST) заголовков или nil вида ("Подпись A" "Подпись B" ...)
Если header nil, принимается ("X" "Y" "Z")
Colhide — список буквенных названий стоблцов для скрытия или nil — не скрывать
("A" "C" "D") — скрыть столбцы A, C, D
Name_list — имя нового листа активной книги или nil — новая книга
* Возврат: nil
* TIPS!!! : При передачи функции xls числовых вещественных данных нет необходимости проверять текущий системный
разделитель целой и дробной части ("HKEY_CURRENT_USER\\Control Panel\\International" "sDecimal")
Функцией на время вывода отключается использование в Excele системного разделителя, разделителем
целой и дробной части устанавливается точка. После завершения ф-ции все восстанавливается.
Пример вызова
(xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Столбец1" "Столбец2" "Столбец3" "Столбец4") '("B"))|;
(vl-load-com)
(defun xls ( Data-list header Colhide Name_list / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26)
TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
Res (strcat (chr (+ 64 TMP)) Res) N (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
(setq *AplExcel* (vlax-get-or-create-object "Excel.Application"))
(if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook"))
(setq *Books-Colection* (vlax-get-property *AplExcel* "Workbooks")
*Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
*Sheet#1* (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection* (vlax-get-property *AplExcel* "Workbooks")
*New-Book* (vlax-invoke-method *Books-Colection* "Add")
*Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
*Sheet#1* (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells* (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (if (= Name_list "")
(vl-filename-base(getvar "DWGNAME"))
(strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
col 0 cols nil)
(if (> (strlen Name_list) 26)
(setq Name_list (strcat (substr Name_list 1 10) "..." (substr Name_list (- (strlen Name_list) 13) 14))))
(vlax-for sh *Sheet-Collection* (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols)))
(setq row Name_list)
(while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
(setq Name_list row)
(vlax-put-property *Sheet#1* 'Name Name_list)
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_не использовать системные установки
(vlax-put-property *AplExcel* "DecimalSeparator" ".") ;_разделитель дробной и целой части
(vlax-put-property *AplExcel* "ThousandsSeparator" " ") ;_разделитель тысячей
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq row 2 col 1)
(repeat (length Data-list)(setq iz_listo (car Data-list))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq Data-list (cdr Data-list))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
(strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell 'Columns))
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
(strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell 'Columns))
(vlax-put-property cols 'hidden 1)
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))
;;;Отрисовка текста
;;; txt — текст
;;; pnt — точка отрисовки в ПСК
;;; heigtht — высота
;;; rotation — угол поворота
;;;justification — или nil
;;;Возвращает имя примитива
(defun text-draw (txt pnt height rotation justification)
(if (null pnt)(command "_.-TEXT" "" txt)
(if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
0.0
) ;_ end of =
(progn
;; нулевая высота текста
(if justification
(command "_.-TEXT" "_J" justification "_none" pnt height rotation txt)
(command "_.-TEXT" "_none" pnt height rotation txt)
) ;_ end of if
) ;_ end of progn
(progn
;; фиксированнная высота
(if justification
(command "_.-TEXT" "_J" justification "_none" pnt rotation txt)
(command "_.-TEXT" "_none" pnt rotation txt)
) ;_ end of if
) ;_ end of progn
) ;_ end of if
)
(entlast)
)

Необходимо скопировать текст в блокнот, сохранить файл *.txt, изменить расширение на *.lsp. В автокаде зайти в Сервис, Приложения, Выбрать файл lsp. Далее запускать из командной строки,сделав надпись COORN.

Добавлено через 12 минут

Кстате информацию по этой теме можно посмотреть http://dwg.ru/art/8
  Ответить с цитированием
Пользователь сказал cпасибо:
dyxa (28.02.2010)

Реклама
Если Вы являетесь автором материала или обладателем авторских прав на него
и против его использования на форуме www.forum.inoe.name , пожалуйста свяжитесь с администрацией форума
Старый 23.09.2009, 14:02   #2
Форумчанин
По умолчанию Re: LISPы для геодезии

есть во какая штука

;************** text_point.lsp *********************************
; Программа отрисовки 3D точек по координатам X и Y,
; соответствующим точке вставки текста и Z, прописанной
; в этой текстовой строке. Если текстовая строка содержит
; не число, то координата Z=0.
; Для отрисовки точек создается специальный слой.

(defun C:TEXT_POINT ( / lay osm tpoint npoint n ent pxy pz)
(setq lay (getvar "CLAYER"))
(setq osm (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq tpoint (ssget))
(if tpoint
(progn
(setq npoint (sslength tpoint))
(setq n 0)
(vl-cmdf "_.UNDO" "_BE")
(vl-cmdf "_-LAYER" "_M" "POINT_TEXT" "_C" 3 "POINT_TEXT" "")
(repeat npoint
(setq ent (entget (ssname tpoint n)))
(if (= (cdr (assoc 0 ent)) "TEXT")
(progn
(setq pxy (cdr (assoc 10 ent)))
(setq pz (cdr (assoc 1 ent)))
(vl-cmdf "_POINT" (list (nth 0 pxy) (nth 1 pxy) (atof pz)))
) ;progn
) ;if
(setq n (1+ n))
) ;repeat
) ; progn
(princ "\n Ничего не выбрано.")
) ;if
(vl-cmdf "_.UNDO" "_E")
(setvar "CLAYER" lay)
(setvar "OSMODE" osm)
(princ)
)

Добавлено через 2 минуты

часто получаем файл dwg с отметками в виде текста этот лисп ставит точку с отметкой Z из текста
Krust вне форума   Ответить с цитированием
Старый 27.02.2010, 16:33   #3
Guest
По умолчанию Re: LISPы для геодезии

Ребят, а почему вы не пользуетесь специализированными продуктами от AUTODESK для этих целей? Например Autodesk Land Desktop или AutoCAD Civil 3D. Я думаю с тем инструментарием, что там есть большая часть ваших вопросов отпадёт.
  Ответить с цитированием
Старый 28.02.2010, 11:44   #4
Форумчанин
По умолчанию Re: LISPы для геодезии

Ребята а можно ли найти Lisp для раставления стрелок автоматически, после снятия координат с Тахеометра. Или что-нибудь для упрощения оформления исполнительной документации? Заранее благодарен!
dyxa вне форума   Ответить с цитированием
Старый 29.05.2010, 23:34   #5
Guest
По умолчанию Re: LISPы для геодезии

Пользуюсь разработками Consistent Software
  Ответить с цитированием
Старый 15.07.2010, 09:31   #6
Форумчанин
По умолчанию Re: LISPы для геодезии

Цитата:
Сообщение от dioxПосмотреть сообщение
Пользуюсь разработками Consistent Software

а какие,например?
rrola вне форума   Ответить с цитированием
Старый 28.02.2011, 13:29   #7
Форумчанин
По умолчанию Re: LISPы для геодезии

Цитата:
Сообщение от rrolaПосмотреть сообщение
а какие,например?

да, не могу выбрать для разводки газовых сетей.
Vitalii2679 вне форума   Ответить с цитированием
Старый 19.05.2011, 17:40   #8
Guest
По умолчанию Re: LISPы для геодезии

Спасибо вам огромное за ёмкий и содержательный ответ! Всё стало ясно -как глаза открыли!
  Ответить с цитированием
Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Литература по геодезии Михаил Нормативная документация общая 46 16.06.2013 22:44


Опции темы

Быстрый переход
Форум для строителей. Снипы, типовые серии, -Eurosoft, Lira Soft, ЛИРА САПР, NormCAD, ФОК, Base и Foundation, типовые серии, типовые проекты и госты все бесплатно можно скачать с нашего форума. А так же обсуждение MagiCAD, стройконсультант, NormaCS и Грандсмета">Форум для строителей и проектировщиков. ЛИРА софт, ЛИРА САПР, STARK ES, SCAD Office, ФОК Софт, BASE и Фундамент, NormCAD, Mathcad, Project Studio CS, СПДС GraphiCS, Типовые серии и проекты, нормативная документация- СНиПы, ГОСТы - скачать бесплатно с форума. А так же обсуждение MagiCAD, СтройКонсультант, NormaCS, Гранд Смета

Проблема: "После захода на форум и ввода логина и пасса всё нормально! Но стоит прерваться на временную паузу минуток 15 и после обновление страницы опять приходится вводит всё заново"
Решение:Когда вы авторизуетесь на форуме, то ставьте галочку рядом со словом "запомнить". Эта опция добавляет в ваш браузер файлы cookie, в которых хранится информация по авторизации. В том случае, если сеанс закончится, он будет возобновлен используя данные хранящиеся в cookie.

Текущее время: 11:52. Часовой пояс GMT +3.


Copyright ©2006 - 2017, Портал INOE. Перевод: zCarot
Форум для строителей и проектировщиков
Сайт не предоставляет электронные версии произведений и ПО, а занимается индексированием файлов, находящихся в файлообменных сетях.
Весь материал, представленный на сайте www.inoe.name взят из открытых источников или прислан посетителями сайта.
Материал используется исключительно в некоммерческих целях. Все права на публикуемые аудио, видео, графические и текстовые материалы принадлежат их владельцам.
Запрещено любое использование материалов сайта без письменного разрешения авторов материала.
Портал www.inoe.name и www.forum.inoe.name ни перед кем ни при каких обстоятельствах не несет ответственности за фактический, побочный, случайный или косвенный ущерб, связанный, а также вызываемый скачиванием файлов посредстом выложенных ссылок нашими пользователями, найденными в сети, и использованием ссылок. Все данные собраны только на добровольном основании.
Если Вы являетесь автором материала или обладателем авторских прав на него
и против его использования на сайте www.inoe.name , пожалуйста свяжитесь с нами
Rambler's Top100