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

rino_black · 18.11.2010, 23:42

здравствуйте,ПОМОГИТЕ МОЛОДОМУ СПЕЦИАЛИСТУ (а то начальник съест со всем чем можно)отредактировать существующий лисп,для построения профиля в ветикальном и горизонтальном масштабе 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

заранее благодарен.очень,очень!

Do$ · 19.11.2010, 12:07

Да пусть ест

раз уж лень написать что редактировать надо

Олег (jr.) · 19.11.2010, 19:25

Цитата:

Сообщение от rino_black

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

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

rino_black · 21.11.2010, 21:34

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

slogos · 24.11.2010, 14:10

А что требует начальник, отредактировать код или, все таки, строить профили?

rino_black · 24.11.2010, 21:26

впринципе начальник требует профиля,но дело в том что их около 120,а этот лисп очень подходит только названия граф поменять.а вы можете помочь с лиспом?

Олег (jr.) · 24.11.2010, 21:39

Цитата:

Сообщение от rino_black

впринципе начальник требует профиля,но дело в том что их около 120,а этот лисп очень подходит только названия граф поменять.а вы можете помочь с лиспом?

Пробуй

slogos · 25.11.2010, 06:31

Профили составляются по файлу топоплана. Мне не хочется разбираться с чужим лиспом, даже если кода не много. А вот если пришлете DWG-файл топоплана, то постараюсь помочь. У меня есть программа составляющая профили.
[email protected]

rino_black · 27.11.2010, 18:10

Олег (jr.) большое спсибо за лисп,ваша помошь лчно для меня не отценима.

Олег (jr.) · 27.11.2010, 19:32

Цитата:

Сообщение от rino_black

Олег (jr.) большое спсибо за лисп,ваша помошь лчно для меня не отценима.

Не за что, это ведь не моя программа, я только пяток строчек изменил

Успехов

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Построение чёрного профиля	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