Скачать NANOCAD Pдгы 8.5
dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > построение профиля с помошью лиспа

построение профиля с помошью лиспа

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 18.11.2010, 23:42 #1
построение профиля с помошью лиспа
rino_black
 
Регистрация: 17.11.2010
Сообщений: 9

rino_black вне форума Вставить имя

здравствуйте,ПОМОГИТЕ МОЛОДОМУ СПЕЦИАЛИСТУ (а то начальник съест со всем чем можно)отредактировать существующий лисп,для построения профиля в ветикальном и горизонтальном масштабе 1/200.
Код:
Код:
[Выделить все]
;; local defun
;; entmake text
(defun entmake-text (str tp rad hgt wdt ali ali2)
(entmake
(list
'(0 . "TEXT") ;тип примитива
'(100 . "AcDbEntity") ;хер знает для чего надо, и без нее пашет норм
'(100 . "AcDbText") ;хер знает для чего надо, и без нее пашет норм
(cons 1 str) ;содержимое текста
(cons 7 (getvar "textstyle")) ;тектсовый стиль
(cons 8 "0") ;слой
(cons 62 256) ;цвет текста
(cons 10 tp) ;начальная точка
(cons 11 tp) ;точка выравнивания
(cons 40 hgt) ;высота текста
(cons 41 wdt) ;фактор сжатия
(cons 50 rad) ;угол поворота в рад
(cons 51 0.0) ;угол наклона
'(71 . 0) ;флаги генерации
(cons 72 ali) ;выравнивание лево центр право
(cons 73 ali2) ;выравнивание низ середина верх
) ;list
) ;entmake
(princ)
)

(defun dtr (a) (* pi (/ a 180.0)))

(defun C:pro (/ anngg dz ucs osn txt p pt1 pt2 ppt1 ppt2 tdis uk ang12)
(setq osn (getvar "OSMODE"))
(setvar "OSMODE" 0)
(if (= (tblsearch "block" "blck001") nil)
(progn (setq namset (ssadd))
(command "_PLINE" '(0 0) "_W" 0.3 0.3 '(0 2) "")
(ssadd (entlast) namset)
(command "_PLINE" '(0 4) "_W" 0.0 2.0 '(0 2) "")
(ssadd (entlast) namset)
(command "_block" "blck001" '(0.0 5.0 0.0) namset "")
) ;progn
) ;if

(setq anngg (getvar "ANGBASE"))
(setq dz (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setvar "CMDECHO" 0)
(setq ucs (getpoint "\n Укажите точку где строить профиль: "))
(command "_UCS" ucs "")
;Рисуем табличку
(command "_rectang" "_w" 0 '(0 0) '(85 10))
(setq txt (substr " Покрытие" 1))
(command "_TEXT" "_ML" '(0 5) 3.5 "0" txt)

(command "_rectang" '(0 20) '(85 10))
(setq txt (substr " Углы поворота" 1))
(command "_TEXT" "_ML" '(0 15) 3.5 "0" txt)

(command "_rectang" '(0 20) '(85 40))
(setq txt (substr " План трассы. Пикетаж." 1))
(command "_TEXT" "_ML" '(0 30) 3.5 "0" txt)

(command "_rectang" '(0 50) '(85 40))
(command "_PLINE" '(0 50) "_w" 0 0 '(85 40) "")
(setq txt (substr " Длина участка" 1))
(command "_TEXT" "_ML" '(0 43) 3.5 "0" txt)
(setq txt (substr "Уклон " 1))
(command "_TEXT" "_MR" '(85 47) 3.5 "0" txt)

(command "_rectang" '(0 50) '(85 60))
(setq txt (substr " Расстояние" 1))
(command "_TEXT" "_ML" '(0 55) 3.5 "0" txt)

(command "_rectang" '(0 70) '(85 60))
(setq txt (substr " Глубина до верха канала" 1))
(command "_TEXT" "_ML" '(0 65) 3.5 "0" txt)

(command "_rectang" '(0 70) '(85 80))
(setq txt (substr " Глубина заложения низа канала" 1))
(command "_TEXT" "_ML" '(0 75) 3.5 "0" txt)

(command "_rectang" '(0 80) '(8 140))
(setq txt (substr "Отметки" 1))
(command "_TEXT" "_MC" '(4 110) 3.5 "90" txt)

(command "_rectang" '(8 80) '(85 95))
(setq txt (substr " Верха труб" 1))
(command "_TEXT" "_ML" '(8 87.5) 3.5 "0" txt)

(command "_rectang" '(8 110) '(85 95))
(setq txt (substr " Низа канала или дна траншеи" 1))
(command "_TEXT" "_ML" '(8 102.5) 3.5 "0" txt)

(command "_rectang" '(8 110) '(85 125))
(setq txt (substr " Верха канала или верха труб" 1))
(command "_TEXT" "_ML" '(8 117.5) 3.5 "0" txt)

(command "_rectang" '(8 140) '(85 125))
(setq txt (substr " Планировки" 1))
(command "_TEXT" "_ML" '(8 132.5) 3.5 "0" txt)

(command "_rectang" '(0 140) '(85 150))
(setq txt (substr " Номера точек" 1))
(command "_TEXT" "_ML" '(0 145) 3.5 "0" txt)

(command "_PLINE"
(setq p '(80 150))
(setq p (polar p (dtr 90) 5))
(setq p (polar p (dtr 180) 15))
""
)

(command "_PLINE"
(setq p '(80 150))
(setq p (polar p (dtr 45) 4))
""
)
(setq p (entlast))
(command "_MIRROR" p "" '(80 150) '(80 151) "")

(setq p (getstring "\n Условный горизонт:"))
(command "_TEXT" '(66 156) 3.5 "0" p)

(setq p (atof p))

(setq txt (substr "М гор. 1:500" 1))
(command "_TEXT" '(30 160) 3.5 "0" txt)
(setq txt (substr "М вер. 1:100" 1))
(command "_TEXT" '(30 154.5) 3.5 "0" txt)
(command "_UCS" '(110 0) "")

(setvar "OSMODE" 8)
(setvar "PDMODE" 35)
(setvar "PDSIZE" 1)

(setq ali 1)
(setq ali2 0)
(setq dis 0.0)
(setq str "ПК 00+00.00")
(setq pt1 (getpoint "\n Укажите точку : "))
(setq pt1 (trans pt1 1 0))
(setq tp (list (car pt1) (+ (cadr pt1) 1) 0))

(setq rad (dtr 0))
(setq hgt 1.0)
(setq wdt 1.0)

(entmake-text str tp rad hgt wdt ali ali2)
(setq rad (dtr 90))
(setq tp '(-2.5 30))
(setq tp (trans tp 1 0))
(setq hgt 2.5)
(setq wdt 1.0)

(entmake-text str tp rad hgt wdt ali ali2)
(command "_PLINE"
(list 0 150)
(list 0 (+ 150 (* (- (last pt1) p) 10)))
""
)
(command "_TEXT"
"_BC"
(list 0 87.5)
3.5
"90"
(rtos (last pt1) 2 2)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Ц И К Л ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(while (setq pt2 (getpoint "\n Укажите точку (ENTER = хватит): "))
(setq pt2 (trans pt2 1 0))

(setq ang12 (atoi (angtos (angle pt1 pt2) 0 0)))
(if (= dis 0)
(setq ang12 nil)
)
(print ang12)
(setvar "ANGBASE" anngg)

(setq ppt1 (list (car pt1) (cadr pt1) 0))
(setq ppt2 (list (car pt2) (cadr pt2) 0))
(setq ali2 0)
(setq ali 1)
(setq tdis (distance ppt1 ppt2))

(setq rad (dtr 0))
(setq dis (+ dis (distance ppt1 ppt2)))
(setq da (fix (/ dis 100))
head (if (< da 10)
(strcat "0" (rtos da 2 0))
(rtos da 2 0)
)
) ;setq da
(setq tail (rtos (- dis (* da 100)) 2 2))
(setq str (strcat "ПК" (chr 32) head "+" tail))

(setq tp (list (car pt2) (+ (cadr pt2) 1) 0))
(setq hgt 1.0)
(setq wdt 1.0)

(entmake-text str tp rad hgt wdt ali ali2)
(setq rad (dtr 90))

(setq tp (list (- (* tdis 2) 2.5) 30))
(setq tp (trans tp 1 0))
(setq hgt 2.5)
(setq wdt 1.0)

(entmake-text str tp rad hgt wdt ali ali2)
(setq uk (/ (- (last pt1) (last pt2)) tdis))
(setvar "OSMODE" 0)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Пишем углы поворота трассы

(if (= (type ang12) (type 1))
(progn

(setq tp (trans (list (+ 0 2) 15) 1 0))
(setq hgt 3.5)
(setq rad 0)
(setq str (itoa ang12))
(setq ali 0)
(setq ali2 1)
(if (> ang12 180)
(progn (command "_insert" "blck001" '(0 10) 1 1 180)
(setq ang12 (- 360 ang12)
ali2 3
str (itoa ang12)
) ;setq
) ;progn
(command "_insert" "blck001" '(0 20) 1 1 0)
) ;if

(entmake-text str tp rad hgt wdt ali ali2)
) ;progn
) ;if

; строим прямоугольники

(command "_rectang"
(list 0 140)
"_D"
(* tdis 2)
10
(list 1 140)
)
(command "_rectang"
(list 0 125)
"_D"
(* tdis 2)
15
(list 1 125)
)
(command "_rectang"
(list 0 110)
"_D"
(* tdis 2)
15
(list 1 110)
)
(command "_rectang"
(list 0 95)
"_D"
(* tdis 2)
15
(list 1 95)
)
(command "_rectang"
(list 0 80)
"_D"
(* tdis 2)
15
(list 1 80)
)

; пишем отметку оси
(command "_TEXT"
"_BC"
(list (* tdis 2) 87.5)
3.5
"90"
(rtos (last pt2) 2 2)
)
; написали

(command "_rectang"
(list 0 70)
"_D"
(* tdis 2)
10
(list 1 70)
)
(command "_rectang"
(list 0 60)
"_D"
(* tdis 2)
10
(list 1 60)
)

; пишем длину
(command "_TEXT"
"_BC"
(list tdis 52)
3.5
"0"
(rtos tdis 2 2)
)
; написали

(command "_rectang"
(list 0 50)
"_D"
(* tdis 2)
10
(list 1 50)
)

; рисуем направление уклона
(if (> uk 0)
(command "_PLINE" (list 0 50) (list (* tdis 2) 40) "")
(command "_PLINE" (list 0 40) (list (* tdis 2) 50) "")
) ;if
(if (= uk 0)
(command "_erase" (entlast) "")
)
; нарисовали

; пишем уклон и длину
(if (= uk 0)
(progn
(command "_TEXT"
"_BC"
(list tdis 44.13)
3.5
"0"
(substr "0.000" 1)
)
(command "_TEXT"
"_BC"
(list tdis 40.13)
3.5
"0"
(rtos tdis 2 2)
)
) ;progn
(progn
(if (> uk 0)
(progn
(command "_TEXT"
"_MR"
(list (- (* tdis 2) 1) 46)
3.5
"0"
(rtos (abs uk) 2 4)
)
(command "_TEXT" "_ML" (list 1 44) 3.5 "0" (rtos tdis 2 2))
) ;progn
(progn
(command "_TEXT"
"_Ml"
(list 1 46)
3.5
"0"
(rtos (abs uk) 2 4)
)
(command "_TEXT"
"_MR"
(list (- (* tdis 2) 1) 44)
3.5
"0"
(rtos tdis 2 2)
)
) ;progn
) ;if
) ;progn
) ;if
; написали

(command "_rectang"
(list 0 40)
"_D"
(* tdis 2)
10
(list 1 40)
)
(command "_rectang"
(list 0 20)
"_D"
(* tdis 2)
20
(list 1 20)
)
(command "_rectang"
(list 0 10)
"_D"
(* tdis 2)
10
(list 1 10)
)
(command "_rectang"
(list 0 0)
"_D"
(* tdis 2)
10
(list 1 0)
)

;построили

;рисуем линии профиля
(command "_PLINE"
(list 0 (+ 150 (* (- (last pt1) p) 10)))
"_W"
0.6
0.6
(list (* tdis 2) (+ 150 (* (- (last pt2) p) 10)))
""
)
(command "_PLINE"
(list (* tdis 2) 150)
"_W"
0
0
(list (* tdis 2) (+ 150 (* (- (last pt2) p) 10)))
""
)
;нарисовали

(command "_UCS" (list (* tdis 2) 0) "")
(print tdis)

(print uk)

(setvar "ANGBASE" (angle pt1 pt2))
(setq pt1 pt2)
(setvar "OSMODE" 8)
) ; while

(setvar "ANGBASE" anngg)
(command "_UCS" "_W")
(setvar "OSMODE" osn)
(setvar "DIMZIN" dz)
(princ)
) ; defun
заранее благодарен.очень,очень!

Вложения
Тип файла: lsp Профиль.lsp (8.4 Кб, 165 просмотров)


Последний раз редактировалось Кулик Алексей aka kpblc, 18.11.2010 в 23:48.
Просмотров: 3331
 
Непрочитано 19.11.2010, 12:07
#2
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,627
Отправить сообщение для Do$ с помощью Skype™


Да пусть ест раз уж лень написать что редактировать надо
Do$ вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 19.11.2010, 19:25
#3
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от rino_black Посмотреть сообщение
здравствуйте,ПОМОГИТЕ МОЛОДОМУ СПЕЦИАЛИСТУ (а то начальник съест со всем чем можно)отредактировать существующий лисп,для построения профиля в ветикальном и горизонтальном масштабе 1/200.
Тема интересная,
Неплохо бы прикрепить чертеж с пояснениями
а то не понятно где указываешь точки и тд
Олег (jr.) вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 21.11.2010, 21:34
#4
rino_black


 
Регистрация: 17.11.2010
Сообщений: 9


как пользоваться лиспом и сам лисп находиться здесь:
http://geostart.ru/phpBB/viewtopic.php?t=3218
но беда в том что он рисует в своих масштабах а что нужно изменить что бы рисовало в тех которые нужны мне я не знаю,т.к. в ЛИСПАХ я вообще не силен =(( прошу помощи у знающих людей,может кто сможет помочь в моей проблеме!мне нужны масштабы гор. и верт.1/200.СПАСИБО!
rino_black вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 24.11.2010, 14:10
#5
slogos


 
Регистрация: 02.06.2009
Сообщений: 36


А что требует начальник, отредактировать код или, все таки, строить профили?
slogos вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 24.11.2010, 21:26
#6
rino_black


 
Регистрация: 17.11.2010
Сообщений: 9


впринципе начальник требует профиля,но дело в том что их около 120,а этот лисп очень подходит только названия граф поменять.а вы можете помочь с лиспом?
rino_black вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 24.11.2010, 21:39
#7
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от rino_black Посмотреть сообщение
впринципе начальник требует профиля,но дело в том что их около 120,а этот лисп очень подходит только названия граф поменять.а вы можете помочь с лиспом?
Пробуй
Вложения
Тип файла: lsp pro_200x200.LSP (9.3 Кб, 264 просмотров)
Олег (jr.) вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 25.11.2010, 06:31
#8
slogos


 
Регистрация: 02.06.2009
Сообщений: 36


Профили составляются по файлу топоплана. Мне не хочется разбираться с чужим лиспом, даже если кода не много. А вот если пришлете DWG-файл топоплана, то постараюсь помочь. У меня есть программа составляющая профили.
logos@pirs.omsknet.ru
slogos вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 27.11.2010, 18:10
#9
rino_black


 
Регистрация: 17.11.2010
Сообщений: 9


Олег (jr.) большое спсибо за лисп,ваша помошь лчно для меня не отценима.
rino_black вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 27.11.2010, 19:32
#10
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от rino_black Посмотреть сообщение
Олег (jr.) большое спсибо за лисп,ваша помошь лчно для меня не отценима.
Не за что, это ведь не моя программа, я только пяток строчек изменил
Успехов
Олег (jr.) вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > построение профиля с помошью лиспа

Инженерные консультации
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Построение чёрного профиля hotirium AutoCAD 4 04.08.2010 07:24
Построение продольного профиля газопровода в AutoCAD 2009 GazRust AutoCAD 32 17.02.2010 13:40
Автоматизация построения профиля (лисп) dextron3 LISP 24 15.10.2008 13:58
Автоматическое построение профиля с исспользованием динамиче RЯков AutoCAD 3 27.04.2007 12:53
Построение профиля Romanich Прочее. Программное обеспечение 3 14.10.2003 11:12

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||


Размещение рекламы