ПЗ (1218806), страница 11
Текст из файла (страница 11)
(unload_dialog dcl_id)
(if (= ddi 1)
(build getType getMark getView getDirection getMultiPlier)
)
(princ)
)
;-----------------------------------------------------
;;;----------------- Светофор --------
(defun c:svet (/ R D stolb osn center down up palka circle3 circle2 circle1 pr ang)
(setq R 1.0)
(setq D (* R 2))
(setq stolb 5.0)
(setq osn 2)
(setq ang (getangle "Укажите угол :"))
(setq center (getpoint "\nМестоположение :"))
(setq down (polar center (- (/ (* 3 pi) 2) (- ang)) (/ osn 2)))
(setq up (polar center (+ (/ pi 2) ang) (/ osn 2)))
(setq palka (polar center ang stolb))
(setq circle3 (polar palka ang R))
(setq circle2 (polar circle3 ang D))
(setq circle1 (polar circle2 ang D))
(setq pr (getvar "osmode"))
(setvar "osmode" 0)
;;;-----------------Рисуем
(command "PLINEWID" 0.1)
(command "_.pline" down up "")
(command "_.pline" palka center "")
(command "_.circle" circle3 R "")
(command "_.circle" circle2 R "")
(command "_.circle" circle1 R "")
(setvar "osmode" 2); Привязка только к центру
); end defun svet()
;--------------------------------
;----- Упор----------------------
(defun c:tupik (/ p1 p2 p3 p3_dop p4 p4_dop width pr ang)
(setq width 3.0)
(setq ang (getangle "\nУкажите угол :"))
(setq p1 (getpoint "\nМестоположение :"))
(setq p2 (polar p1 ang 10))
(setq p3 (polar p2 (+ (/ pi 2) ang) (/ width 2))) ; to up
(setq p3_dop (polar p3 ang 1.0))
(setq p4 (polar p2 (- (/ (* 3 pi) 2) (- ang)) (/ width 2))) ; to down
(setq p4_dop (polar p4 ang 1.0))
(setq pr (getvar "osmode"))
(setvar "osmode" 0)
(command "_.pline" p1 p2 "")
(command "_.pline" p2 p3 p3_dop "")
(command "_.pline" p2 p4 p4_dop "")
(command "PLINEWID" getWidthStancPut)
(setvar "osmode" 1)
)
;------------------------СОПРЯЖЕНИЕ----------------
(defun make (radius /)
(setq FIL (getvar "FILLETRAD"))
(setvar "FILLETRAD" radius)
(command "_.fillet" "P")
)
(defun det ()
(setq radius (atoi (get_tile "Rad_skrug")))
)
(defun c:skrug (/ dcl_id radius)
(setq dcl_id(load_dialog "C:/Users/Игорь/Desktop/diplom/group/Dialogs/skrug_menu.dcl"))
(if (null (new_dialog "skrug" dcl_id))
(exit)
)
(action_tile "accept" "(det) (done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq ddi (start_dialog))
(unload_dialog dcl_id)
(if (= ddi 1)
(make radius)
)
(princ)
)
;--------------------------------------------
;-------------Станционные пути-------------------------
(defun c:build2()
(command "PLINEWID" getWidthStancPut) ;- существующие
(setq T1 (getpoint "\nУкажите местоположение: "))
(setq T2 (getpoint T1 "\nУкажите длину"))
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(command "_.pline" T1 T2)
(setvar "osmode" 32)
)
;-------------------------------------------------------
;-------------Главные пути------------------------------
(defun c:build1()
(command "PLINEWID" getWidthMainPut) ; - существующие
(setq T1 (getpoint "\nУкажите местоположение: "))
(setq T2 (getpoint T1 "\nУкажите длину"))
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(command "_.pline" T1 T2)
(setvar "osmode" 32)
)
;-------------------------------------------------------
;------------Параллельная укладка смежных стрелочных переводов----
(defun main_par(getPaths getTypeR getMark getView getFirst getSecond getE / ang n1 n2 n11 n3 n22 n4 osm center1 center2 center3 center4)
(if (and (= getFirst 0) (= getSecond 0) (= getView 0)) ;000
(progn
(setq ang (getangle "Укажите угол"))
(setq n2 (getpoint "Укажите место отрисовки"))
(setq n1 (polar n2 ang (- a1)))
(setq n11 (polar n2 (+ ang alpha1) b1))
(setq n3 (polar n2 ang X))
(setq n22 (polar n3 (+ ang alpha2) b2))
(setq n4 (polar n3 ang b2))
)
)
(if (and (= getFirst 0) (= getSecond 0) (= getView 1)) ;001
(progn
(setq ang (getangle "Укажите угол"))
(setq n2 (getpoint "Укажите место отрисовки"))
(setq n1 (polar n2 ang (- a1)))
(setq n11 (polar n2 (+ ang (- alpha1)) b1))
(setq n3 (polar n2 ang X))
(setq n22 (polar n3 (+ ang (- alpha2)) b2))
(setq n4 (polar n3 ang b2))
)
)
(if (and (= getFirst 0) (= getSecond 1) (= getView 0)) ;010
(progn
(setq ang (getangle "Укажите угол"))
(setq n2 (getpoint "Укажите место отрисовки"))
(setq n1 (polar n2 ang (- a1)))
(setq n11 (polar n2 (+ ang alpha1) b1))
(setq n3 (polar n2 ang X))
(setq n22 (polar n3 (+ ang (- alpha_othervar2)) b2))
(setq n4 (polar n3 ang b2))
)
)
(if (and (= getFirst 0) (= getSecond 1) (= getView 1)) ;011
(progn
(setq ang (getangle "Укажите угол"))
(setq n2 (getpoint "Укажите место отрисовки"))
(setq n1 (polar n2 ang (- a1)))
(setq n11 (polar n2 (+ ang (- alpha1) b1)))
(setq n3 (polar n2 ang X))
(setq n22 (polar n3 (+ ang alpha_othervar2) b2))
(setq n4 (polar n3 ang b2))
)
)
(if (and (= getFirst 1) (= getSecond 0) (= getView 0)) ;100
(progn
(setq ang (getangle "Укажите угол"))
(setq n2 (getpoint "Укажите место отрисовки"))
(setq n1 (polar n2 ang (- a1)))
(setq n11 (polar n2 (+ ang (- alpha_othervar1)) b1))
(setq n3 (polar n2 ang X))
(setq n22 (polar n3 alpha2 b2))
(setq n4 (polar n3 ang b2))
)
)
(if (and (= getFirst 1) (= getSecond 0) (= getView 1)) ;101
(progn
(setq ang (getangle "Укажите угол"))
(setq n2 (getpoint "Укажите место отрисовки"))
(setq n1 (polar n2 ang (- a1)))
(setq n11 (polar n2 (+ ang alpha_othervar1) b1))
(setq n3 (polar n2 ang X))
(setq n22 (polar n3 (+ ang (- alpha2)) b2))
(setq n4 (polar n3 ang b2))
)
)
(if (and (= getFirst 1) (= getSecond 1) (= getView 0)) ;110
(progn
(setq ang (getangle "Укажите угол"))
(setq n2 (getpoint "Укажите место отрисовки"))
(setq n1 (polar n2 ang (- a1)))
(setq n11 (polar n2 (+ ang (- alpha_othervar1)) b1))
(setq n3 (polar n2 ang X))
(setq n22 (polar n3 (+ ang (- alpha_othervar2)) b2))
(setq n4 (polar n3 ang b2))
)
)
(if (and (= getFirst 1) (= getSecond 1) (= getView 1)) ;111
(progn
(setq ang (getangle "Укажите угол"))
(setq n2 (getpoint "Укажите место отрисовки"))
(setq n1 (polar n2 ang (- a1)))
(setq n11 (polar n2 (+ ang alpha_othervar1) b1))
(setq n3 (polar n2 ang X))
(setq n22 (polar n3 (+ ang alpha_othervar2) b2))
(setq n4 (polar n3 ang b2))
)
)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(command "PLINEWID" getWidthSmezhStr)
(setq center1 (polar n2 (+ (/ pi 2) ang) 1))
(setq center2 (polar n2 (- (/ (* 3 pi) 2) (- ang)) 1))
(setq center3 (polar n3 (+ (/ pi 2) ang) 1))
(setq center4 (polar n3 (- (/ (* 3 pi) 2) (- ang)) 1))
(setvar "osmode" 0)
(command "_.pline" n1 n2 n3 n4 "")
(command "_.pline" n2 n11 "")
(command "_.pline" n3 n22 "")
(command "_.pline" center1 center2 "")
(command "_.pline" center3 center4 "")
(setvar "osmode" 1)
)
(defun def_par ()
(setq getPaths (atoi (get_tile "paths")))
(setq getTypeR (atoi (get_tile "type_r_paral")))
(setq getMark (atoi (get_tile "marka_paral")))
(setq getView (atoi (get_tile "view_paral")))
(setq getFirst (atoi (get_tile "first_napr")))
(setq getSecond (atoi (get_tile "second_napr")))
(setq getE (atoi (get_tile "e")))
(if (and (= getPaths 0) (= getTypeR 0) (= getMark 0)) ; 000
(progn
(setq alpha1 0.0906601583674)
(setq alpha2 0.0906601583674)
(setq alpha_othervar1 3.05093249523)
(setq alpha_othervar2 3.05093249523)
(setq a1 14.063)
(setq a2 14.063)
(setq b1 19.304)
(setq b2 19.304)
(setq X (/ getE (sin alpha1)))
)
)
(if (and (= getPaths 0) (= getTypeR 0) (= getMark 1)) ; 001
(progn
(setq alpha1 0.110658722713)
(setq alpha2 0.110658722713)
(setq alpha_othervar1 3.03093393087)
(setq alpha_othervar2 3.03093393087)
(setq a1 15.227)
(setq a2 15.227)
(setq b1 15.812)
(setq b2 15.812)
(setq X (/ getE (sin alpha1)))
)
)
(if (and (= getPaths 0) (= getTypeR 1) (= getMark 0)) ; 010
(progn
(setq alpha1 0.0906601583674)
(setq alpha2 0.0906601583674)
(setq alpha_othervar1 3.05093249523)
(setq alpha_othervar2 3.05093249523)
(setq a1 14.475)
(setq a2 14.475)
(setq b1 19.054)
(setq b2 19.054)
(setq X (/ getE (sin alpha1)))
)
)
(if (and (= getPaths 0) (= getTypeR 1) (= getMark 1)) ; 011
(progn
(setq alpha1 0.110658722713)
(setq alpha2 0.110658722713)
(setq alpha_othervar1 3.03093393087)
(setq alpha_othervar2 3.03093393087)
(setq a1 15.459)
(setq a2 15.459)
(setq b1 15.602)
(setq b2 15.602)
(setq X (/ getE (sin alpha1)))
)
)
(if (and (= getPaths 1) (= getTypeR 0) (= getMark 0)) ; 100
(progn
(setq alpha1 0.0906601583674)
(setq alpha2 0.0906601583674)
(setq alpha_othervar1 3.05093249523)
(setq alpha_othervar2 3.05093249523)
(setq a1 14.063)
(setq a2 14.063)
(setq b1 19.304)
(setq b2 19.304)
(setq X (/ getE (sin alpha1)))
)
)
(if (and (= getPaths 1) (= getTypeR 0) (= getMark 1)) ; 101
(progn
(setq alpha1 0.110658722713)
(setq alpha2 0.110658722713)
(setq alpha_othervar1 3.03093393087)
(setq alpha_othervar2 3.03093393087)
(setq a1 15.227)
(setq a2 15.227)
(setq b1 15.812)
(setq b2 15.812)
(setq X (/ getE (sin alpha1)))
)
)
(if (and (= getPaths 1) (= getTypeR 1) (= getMark 0)) ; 110
(progn
(setq alpha1 0.0906601583674)
(setq alpha2 0.0906601583674)
(setq alpha_othervar1 3.05093249523)
(setq alpha_othervar2 3.05093249523)
(setq a1 14.475)
(setq a2 14.475)
(setq b1 19.054)
(setq b2 19.054)
(setq X (/ getE (sin alpha1)))
)
)
(if (and (= getPaths 1) (= getTypeR 1) (= getMark 1)) ; 111
(progn
(setq alpha1 0.110658722713)
(setq alpha2 0.110658722713)
(setq alpha_othervar1 3.03093393087)
(setq alpha_othervar2 3.03093393087)
(setq a1 15.459)
(setq a2 15.459)
(setq b1 15.602)
(setq b2 15.602)
(setq X (/ getE (sin alpha1)))
)
)
(if (and (= getPaths 2) (= getTypeR 0) (= getMark 0)) ; 200
(progn
(setq alpha1 0.0906601583674)
(setq alpha2 0.0906601583674)
(setq alpha_othervar1 3.05093249523)
(setq alpha_othervar2 3.05093249523)
(setq a1 14.063)
(setq a2 14.063)
(setq b1 19.304)
(setq b2 19.304)
(setq X (/ getE (sin alpha1)))
)
)
(if (and (= getPaths 2) (= getTypeR 0) (= getMark 1)) ; 201
(progn
(setq alpha1 0.110658722713)
(setq alpha2 0.110658722713)
(setq alpha_othervar1 3.03093393087)
(setq alpha_othervar2 3.03093393087)
(setq a1 15.227)
(setq a2 15.227)