Архитектору и проектировщику|Тепло- и звукоизоляция URSA.RU
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > Для вертикальной планировки

Для вертикальной планировки

Ответ
Поиск в этой теме
Непрочитано 11.07.2012, 19:02 #1
Для вертикальной планировки
baaba
 
архитектор
 
Москва
Регистрация: 07.07.2007
Сообщений: 622

Сделал небольшие приспособления для построения вертикалки. Делал под себя. Вот, тема тут уже проскакивала:
http://forum.dwg.ru/showthread.php?t=25571
Коротко о программе: можно строить горизонтали по трём точкам (значения высот задаются в текстовых примитивах выносок. Наглядно представлено во вложенном vertic.dwg), пожно строить дорогу с двускатным или односкатным профилем. Поперечные уклоны и шаг сечения рельефа задаются в тексте программы. Should - полуширина дороги. Эти инструменты будут полезны вкупе с программкой для построения земляных масс:
http://forum.dwg.ru/showthread.php?t=64460
Кстати там есть функция det, позволяющая получать значение высоты точки, принадлежащей плоскости, заданной по трём точкам.
PS Модераторы, добавте плз. возможность вложения *.7z!?

Код:
[Выделить все]
 ;|
Программа упрощает выполнение вертикальной планировки методом горизонталей. Принцип действия наглядно представлен в прилагаемом vertic.dwg Значения высот беруться из значений текстовых примитивов (выноски на плане).

WPROMI - вычисляет уклон между двумя точками;
SPROMI - устанавливает отметку по заданному пользователем углу (в промилях);
TRIPOD - строит линии равной высоты с заданием поверхности по трём точкам;
MKROAD - строит горизонтали дороги с двускатным поперечным профилем;
MKROAD2 - строит горизонтали дороги с односкатным поперечным профилем;
GIPER - строит герполоидальную поверхность по 4-м точкам (важна последовательность указания точек).

Шаг сечения рельефа задаётся глобальной переменной *st* в тексте программы. Аналогично указывается поперечный уклон (в промилях) поперечного профиля дороги, глобальная переменная *promi-across*, для случая MKROAD, MKROAD2.
|;

(setq 
	*promi-across* 20.0 ;значение поперечного профиля
	*st* 0.1 ;шаг сечения рельефа
)

;http://faqs.org.ru/progr/graph/autolisp3.htm	
(defun draw_line (pts) ; Draw pline by getting list
	(command "_.LINE")
	(mapcar 'command pts)
	(command ""))

;(atof (cdr (assoc 1 (entget (car (entsel))))))
;(gnum2 "\nSelect height:\n")
(defun gnum2 (msg)
	(atof (cdr (assoc 1 (entget (car (entsel msg)))))))

;Возвращает список с откушенным последним элементом
(defun ucdr (lst)
	(reverse (cdr (reverse lst)))
)

;(setq tlst (trpd))
(defun trpd (/ lst)
	(setq lst ())
	(repeat 3 (setq lst (cons
		(append (ucdr (getpoint "\nSelect point")) (list (gnum2 "\nSelect height:\n")))
		lst)))
	lst
)

(defun arrangebyheight (lst / tmp a b c)
	(if (not (>= (caddr (setq a (car lst))) (caddr (setq b (cadr lst)))))
		(setq tmp a a b b tmp))
	(if (not (<= (caddr (setq c (caddr lst))) (caddr b)))
		(if (not (<= (caddr c) (caddr a)))
			(setq tmp a a c c b b tmp)
			(setq tmp b b c c tmp)
		)
	)
	(list a b c)
)

;(rndby (caddr (car tl)) 0.1)
(defun rndby (a q)
	(* q (atoi (rtos (/ a q) 2 1)))
)

;(mkpts tl 0.1)
;(mapcar 'draw_line (mkpts tl 0.1))
(defun mkpts (lst st / p1 p2 p3 p4 p5 p6 h1 h2 h3 stpl lsto)
	(setq
		p1 (ucdr (car lst)) h1 (caddr (car lst))
		p2 (ucdr (cadr lst)) h2 (caddr (cadr lst))
		p3 (ucdr (caddr lst)) h3 (caddr (caddr lst))
		p4 (polar p1 (angle p1 p3) (* (distance p1 p3) (/ (- h1 h2) (- h1 h3))))
		p5 (polar p1 (angle p1 p3) (* (distance p1 p3) (/ (- h1 (rndby h1 st)) (- h1 h3))))
		p6 (polar p5 (angle p4 p2) (distance p4 p2))
		stpl (* st (/ (distance p1 p3) (- h1 h3)))
		lsto (list (list p5 p6))
		)
	
	(repeat
		(if (not (= 0 (setq n (atoi (rtos (/ (- h1 h3) 0.1) 2 0))))) n 1)
			(setq lsto (cons (list
			(setq p5 (polar p5 (angle p1 p3) stpl))
			(setq p6 (polar p6 (angle p1 p3) stpl))
				) lsto)))

)

(defun c:tripod (/ pts)

(command "_.undo" "_begin"); Метка отмены группы комманд
(setq
	pts (mkpts (arrangebyheight (trpd)) *st*)
)
(setq old_osnap (getvar "OSMODE")); Старая привязка
(setvar "OSMODE" 0); Сброс всех привязок

(mapcar 'draw_line pts)

(setvar "OSMODE" old_osnap)

;Метка отмены группы комманд
(command "_.undo" "_end")
)

; Функция возвращает список DXF кодов выбранного объекта
(defun gcode (_msg) (entget (car (entsel _msg)))) 

; Функция изменяет значение текстовой строки
(defun txtch (_tval _msg / _tg)
	(setq _tg (gcode _msg))
	(entmod (subst (cons 1 _tval) (assoc 1 _tg) _tg))
)

(defun c:spromi (/ pt1 pt2 h1 pr)
	(setq pt1 (getpoint "\nSelect first point\n"))
	(setq h1 (gnum2 "\nSelect first height\n"))
	(setq pt2 (getpoint "\nSelect second point\n"))
	(setq pr (getreal "\nEnter promil value\n"))
	(txtch (rtos (+ h1 (* (/ pr 1000.0) (distance pt1 pt2))) 2 2) "\nSelect target text\n")
)

(defun c:wpromi (/ pt1 pt2 h1 h2)
	(setq pt1 (getpoint "\nSelect first point\n"))
	(setq h1 (gnum2 "\nSelect first height\n"))
	(setq pt2 (getpoint "\nSelect second point\n"))
	(setq h2 (gnum2 "\nSelect first height\n"))
	(* (/ (- h1 h2) (distance pt1 pt2)) 1000.0)
)


;(mkroadpts p1 p2 h1 h2 st should *promi-across*)
(defun mkroadpts (pt1 pt2 h1 h2 st should pr / tmp an rat p3 p4 p5 olst n)
	(if (< h1 h2)
		(setq
			tmp h1 h1 h2 h2 tmp
			tmp p1 p1 p2 p2 tmp
		))
	(setq
		an (angle p1 p2)
		rat (/ (distance p1 p2) (- h1 h2))
		p3 (polar p1 an (* (- h1 (rndby h1 st)) rat))
		stpl (* st rat)
		p4 (polar (polar p3 (- an pi ) (/ (* should stpl pr) st 1000) ) (+ an (/ pi 2)) should)
		p5 (polar p4 (- an (/ pi 2)) (* 2 should))
		olst (list (list p4 p3 p5))
		)
	
	(repeat
		(if (not (= 0 (setq n (atoi (rtos (/ (- h1 h2) 0.1) 2 0))))) n 1)
			(setq olst (cons (mapcar '(lambda (x) (polar x an stpl)) (car olst)) olst)))
)

(defun c:mkroad (/ p1 p2 h1 h2 should)
	(command "_.undo" "_begin")
	(setq
		p1 (getpoint "\nSelect first point\n")
		h1 (gnum2 "\nSelect first height\n")
		p2 (getpoint "\nSelect second point\n")
		h2 (gnum2 "\nSelect second height\n")
		should (getreal "\nShould:")
	)
	(setq old_osnap (getvar "OSMODE")); Старая привязка
	(setvar "OSMODE" 0); Сброс всех привязок
	(mapcar 'draw_line (mkroadpts p1 p2 h1 h2 *st* should *promi-across*))
	(setvar "OSMODE" old_osnap)
	(command "_.undo" "_end")
)

;(mkroadpts2 p1 p2 h1 h2 *st* should *promi-across*)
(defun mkroadpts2 (pt1 pt2 h1 h2 st should pr / tmp an rat p3 p4 p5 olst n)
	(if (< h1 h2)
		(setq
			tmp h1 h1 h2 h2 tmp
			tmp p1 p1 p2 p2 tmp
		))
	(setq
		an (angle p1 p2)
		rat (/ (distance p1 p2) (- h1 h2))
		p3 (polar p1 an (* (- h1 (rndby h1 st)) rat))
		stpl (* st rat)
		p4 (polar (polar p3 (- an pi ) (/ (* should stpl pr) st 1000) ) (- an (/ pi 2)) should)
		p5 (polar p4 (angle p4 p3) (* 2 (distance p3 p4)))	
		olst (list (list p4 p5))
		)
	(repeat
		(if (not (= 0 (setq n (atoi (rtos (/ (- h1 h2) 0.1) 2 0))))) n 1)
			(setq olst (cons (mapcar '(lambda (x) (polar x an stpl)) (car olst)) olst)))
)

(defun c:mkroad2 (/ p1 p2 h1 h2 should)
	(command "_.undo" "_begin")
	(setq
		p1 (getpoint "\nSelect first point\n")
		h1 (gnum2 "\nSelect first height\n")
		p2 (getpoint "\nSelect second point\n")
		h2 (gnum2 "\nSelect second height\n")
		should (getreal "\nShould:")
	)
	(setq old_osnap (getvar "OSMODE")); Старая привязка
	(setvar "OSMODE" 0); Сброс всех привязок
	(mapcar 'draw_line (mkroadpts2 p1 p2 h1 h2 *st* should *promi-across*))
	(setvar "OSMODE" old_osnap)
	(command "_.undo" "_end")
)

(defun giperpts (p1 p2 p3 p4 h1 h2 h3 h4 st / tmp mah mih rat1 rat2 an1 an2 stpl1 stpl2 p5 p6 olst n)
	(if (< h1 h2)
		(setq
			tmp h1 h1 h2 h2 tmp
			tmp p1 p1 p2 p2 tmp
		))
	(if (< h3 h4)
		(setq
			tmp h3 h3 h4 h4 tmp
			tmp p3 p3 p4 p4 tmp
		))
	(setq
		mah (max h1 h2 h3 h4)
		mih	(min h1 h2 h3 h4) 
		an1 (angle p2 p1)
		an2 (angle p4 p3)
		rat1 (/ (distance p1 p2) (- h1 h2))
		rat2 (/ (distance p3 p4) (- h3 h4))
		stpl1 (* st rat1)
		stpl2 (* st rat2)
		p5 (polar p1 an1 (* (- (rndby mah st) h1) rat1))
		p6 (polar p3 an2 (* (- (rndby mah st) h3) rat2))
		olst (list (list p5 p6))
	)
	(repeat
		(if (not (= 0 (setq n (atoi (rtos (/ (- mah mih) st) 2 0))))) n 1)
			(setq olst (cons (mapcar '(lambda (x y z) (polar x y z)) (car olst) (list (- an1 pi) (- an2 pi)) (list stpl1 stpl2)) olst)))
 
)

(defun c:giper (/ p1 p2 p3 p4 h1 h2 h3 h4 tmp)
	(setq 
		p1 (getpoint "\nSelect first point\n")
		h1 (gnum2 "\nSelect first height\n")
		p2 (getpoint "\nSelect second point\n")
		h2 (gnum2 "\nSelect second height\n")
		p3 (getpoint "\nSelect third point\n")
		h3 (gnum2 "\nSelect third height\n")
		p4 (getpoint "\nSelect fourth point\n")
		h4 (gnum2 "\nSelect fourth height\n")
	)

	(command "_.undo" "_begin")
	(setq old_osnap (getvar "OSMODE")); Старая привязка
	(setvar "OSMODE" 0); Сброс всех привязок
	(mapcar 'draw_line (giperpts p1 p2 p3 p4 h1 h2 h3 h4 *st*))	
	(setvar "OSMODE" old_osnap)
	(command "_.undo" "_end")


)
"TRIPOD SPROMI WPROMIL MKROAD MKROAD2 GIPER"

Вложения
Тип файла: zip vertic.zip (25.8 Кб, 570 просмотров)


Последний раз редактировалось baaba, 12.07.2012 в 03:33.
Просмотров: 9919
 
Непрочитано 27.05.2013, 07:18
#2
Valery Brelovsky

Инженер дорожник
 
Регистрация: 22.10.2007
Израиль
Сообщений: 1,848


строит линии равной высоты с заданием поверхности по трём точкам
Только по трём точкам или точек может быть больше.

строит герполоидальную поверхность по 4-м точкам (важна последовательность указания точек).

В чём заключается последовательность.
Valery Brelovsky вне форума  
 
Непрочитано 10.02.2016, 10:46
#3
2shcan


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


У меня не работает в 2015 автокаде. В 2010 отлично работал. А в 2015 не работает.
Команда: MKROAD

Select first point

Select first height

Select second point

Select second height

Should:1
VVC: Internal Error'VLIDE

Помогите, кто понимает что произошло?
2shcan вне форума  
 
Непрочитано 10.02.2016, 13:45
#4
Do$

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


Это потому что командные методы. В 2015 версии добавили функцию COMMAND-S. Ищите по форуму, обсуждали уже и не раз.
__________________
Толковый выбор приходит с опытом, а к нему приводит выбор бестолковый. (The Mechanic)
Do$ вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > Для вертикальной планировки

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
ЛИРА Супер элементы -для чего они? L`esprit Лира / Лира-САПР 11 26.06.2014 18:44
АВТОКАД с чего начать изучение, ОПС Alexandr_Kovalevskiy AutoCAD 21 08.09.2010 09:01
От чего делают замеры при строительстве монолитных зданий? Vova Технология и организация строительства 53 21.11.2009 15:05
Проект вентилируемого фасада, с чего начать? Mr_Necromancer AutoCAD 7 30.05.2008 06:03
LISP с чего начать? Димка LISP 1 04.06.2007 22:39