Главная Случайная страница


Полезное:

Как сделать разговор полезным и приятным Как сделать объемную звезду своими руками Как сделать то, что делать не хочется? Как сделать погремушку Как сделать так чтобы женщины сами знакомились с вами Как сделать идею коммерческой Как сделать хорошую растяжку ног? Как сделать наш разум здоровым? Как сделать, чтобы люди обманывали меньше Вопрос 4. Как сделать так, чтобы вас уважали и ценили? Как сделать лучше себе и другим людям Как сделать свидание интересным?


Категории:

АрхитектураАстрономияБиологияГеографияГеологияИнформатикаИскусствоИсторияКулинарияКультураМаркетингМатематикаМедицинаМенеджментОхрана трудаПравоПроизводствоПсихологияРелигияСоциологияСпортТехникаФизикаФилософияХимияЭкологияЭкономикаЭлектроника






Пример выполнения





(defun c:VAL()

 

(command "layer" "s" "0" "")

 

(command "snap" 1)

(command "osnap" "off")

 

(setq p0(getpoint "\nВведите центр фигуры: ")) (princ p0)

 

(initget 1 "BR SR RR")

(setq flag (getkword "\nВведите способ построения (Большой радиус (BR)/Малый радиус(SR)/Большой и малый радиусы(RR)): "))

 

(if (= flag "BR")

;********************************************************************* (progn

(setq fl1 T)

(while fl1

;*********************************************************************

;(progn

(setq fl T)

(while fl

(setq L(getdist p0 "\nВведите расстояние между центрами окружностей: ")) (princ L)

(if (or (NULL L) (MinusP L) (ZeroP L))

(progn (princ "\nНе правильно задан параметр!!!\n") (setq fl T)) (setq fl nil))

);while

 

(setq fl T)

(while fl

(setq br(getdist p0 "\nВведите большой радиус: ")) (princ br)

(if (or (NULL br) (MinusP br) (ZeroP br))

(progn (princ "\nНе правильно задан параметр!!!\n") (setq fl T)) (setq fl nil))

);while

 

(setq sr(- br L))

(if (< sr L br) (progn (princ "\nНормальные параметры") (setq fl1 nil))

(princ "\n!!!!!!!!!!!Параметры заданы не верно!!!!!!!!!!!"))

)

)

;***************************************************************************)

(if (= flag "SR")

;********************************************************************* (progn

(setq fl1 T)

(while fl1

;*********************************************************************

(setq fl T)

(while fl

(setq L(getdist p0 "\nВведите расстояние между центрами окружностей: ")) (princ L)

(if (or (NULL L) (MinusP L) (ZeroP L))

(progn (princ "\nНе правильно задан параметр!!!\n") (setq fl T)) (setq fl nil))

);while

 

(setq fl T)

(while fl

(setq sr(getdist p0 "\nВведите малый радиус: ")) (princ sr)

(if (or (NULL sr) (MinusP sr) (ZeroP sr))

(progn (princ "\nНе правильно задан параметр!!!\n") (setq fl T)) (setq fl nil))

);while

 

(setq br(+ sr L))

(if (< sr L br) (progn (princ "\nНормальные параметры") (setq fl1 nil)) (princ "\n!!!!!!!!!!!Параметры заданы не верно!!!!!!!!!!!"))

)

)

;*********************************************************************

)

(if (= flag "RR")

;********************************************************************* (progn

(setq fl1 T)

(while fl1

;*********************************************************************

(setq fl T)

(while fl

(setq br(getdist p0 "\nВведите большой радиус: ")) (princ br)

(if (or (NULL br) (MinusP br) (ZeroP br))

(progn (princ "\nНе правильно задан параметр!!!\n") (setq fl T)) (setq fl nil))

);while

 

(setq fl T)

(while fl

(setq sr(getdist p0 "\nВведите малый радиус: ")) (princ sr)

(if (or (NULL sr) (MinusP sr) (ZeroP sr))

(progn (princ "\nНе правильно задан параметр!!!\n") (setq fl T)) (setq fl nil))

);while

 

(setq L(- br sr))

(if (< sr L br) (progn (princ "\nНормальные параметры") (setq fl1 nil)) (princ"\n!!!!!!!!!!! Параметры заданы не верно!!!!!!!!!!!"))

)

)

;***************************************************************************

)

(command "snap" "off")

 

(setq p1 (list (- (car p0) (/ L 2)) (- (car (cdr p0)) (/ L 3))))

 

(setq p2 (list (+ (car p1) L) (car (cdr p1))))

 

(setq tx (+ (car p1) (/ L 2)))

(setq ty (+(car (cdr p1))(sqrt (- (* L L) (/ (* L L) 4)))))

 

(Setq p3 (list tx ty))

 

(setq tx (- (car p1) sr))

(setq ty (car (cdr p1)))

(setq p4 (list tx ty))

 

(setq delta (sqrt(-(* sr sr)(/ (* sr sr) 4))))

 

(setq tx (-(car p1)(/ sr 2)))

(setq ty (-(car(cdr p1))delta))

(setq p5 (list tx ty))

 

(setq tx (+(car p2)(/ sr 2)))

(setq ty (car(cdr p5)))

(setq p6 (list tx ty))

 

(setq tx (+(car p2) sr))

(setq ty (car(cdr p2)))

(setq p7 (list tx ty))

 

(setq tx (+(car p3)(/ sr 2)))

(setq ty (+(car(cdr p3))delta))

(setq p8 (list tx ty))

 

(setq tx (-(car p3)(/ sr 2)))

(setq ty (+(car(cdr p3))delta))

(setq p9 (list tx ty))

 

;вид спереди

(command "pline" p4 "Arc" "ce" p1 p5 "ce" p3 p6 "ce" p2 p7 "ce" p1 p8 "ce" p3 p9 "ce" p2 p4 "cl")

(command "layer" "s" "Hatch" "")

(command "-bhatch" "p" "ANSI31" 3 0 "s" p4 "" "")

 

(command "layer" "s" "Построение" "")

 

(command "line" p4 p7 \\)

(command "line" p6 p9 \\)

(command "line" p5 p8 \\)

 

(command "layer" "s" "Разметка" "")

(setq tx (list (car p1) (+ sr 2 (car (cdr p1)))))

(setq ty (list (car p1) (- (car (cdr p1)) sr 2)))

(command "line" tx ty \\)

 

(setq tx (list (+ sr 2 (car p1)) (car (cdr p1))))

(setq ty (list (- (car p1) sr 2) (car (cdr p1))))

(command "line" tx ty \\)

 

(setq tx (list (car p2) (+ sr 2 (car (cdr p2)))))

(setq ty (list (car p2) (- (car (cdr p2)) sr 2)))

(command "line" tx ty \\)

 

(setq tx (list (+ sr 2 (car p2)) (car (cdr p2))))

(setq ty (list (- (car p2) sr 2) (car (cdr p2))))

(command "line" tx ty \\)

 

(setq tx (list (car p3) (+ sr 10 (car (cdr p3)))))

(setq ty (list (car p3) (- (car (cdr p3)) br 10)))

(command "line" tx ty \\)

 

(setq tx (list (+ sr 2 (car p3)) (car (cdr p3))))

(setq ty (list (- (car p3) sr 2) (car (cdr p3))))

(command "line" tx ty \\)

 

(command "layer" "s" "0" "")

 

(command "ortho" "on")

 

(setq t1 (list (+ (car p2) sr 50) (- (car (cdr p3)) br)))

 

(setq L1(getdist t1 "\nВведите длину вала: "))

(setq fas(getdist t1 "\nВведите размер фаски: "))

 

(command "ortho" "off")

 

(setq t2 (list (-(+ (car t1) L1) fas) (car (cdr t1))))

(setq t3 (list (car t2) (+ (car (cdr t1)) br sr)))

(setq t4 (list (car t1) (car (cdr t3))))

(setq t5 (list (- (car t1) fas) (- (car (cdr t4)) fas)))

(setq t6 (list (car t5) (+ (car (cdr t1)) fas)))

 

(command "pline" t1 t2 t3 t4 t5 t6 "cl")

 

(command "layer" "s" "Построение" "")

 

(command "line" (list (car p0) (car (cdr t1))) t1 "")

(command "line" (list (car p0) (car (cdr t4))) t4 "")

 

(command "layer" "s" "Разметка" "")

(setq ttx (- (car t6) 5))

(setq tty (+ (car (cdr t1)) (/ (- (car (cdr t4)) (car (cdr t1))) 2)))

(setq tt1 (list ttx tty))

(setq tt2 (list (+ ttx l1 10) tty))

(command "line" tt1 tt2 \\)

 

 

(command "layer" "s" "Dim" "")

(command "dimlinear" p1 p2 "H" (list (car p3) (- (car (cdr p3)) br 10)))

(command "dimlinear" t2 t3 "V" (list (+ ttx l1 15) tty))

(command "dimlinear" t5 t3 "H" (list (- (car t3) (/ L1 2)) (+ 10 (car (cdr t3)))))

(setq str (strcat "45%%dx" (rtos fas 2 2)))

(command "dimlinear" t1 t6 "H" "T" str (list (+ (car t1) 10) (- (car (cdr t1)) 10)))

 

(command "arc" p4 "c" p1 p5)

(command "arc" p9 "c" p2 p4)

 

(command "dimradius" p5 (list (- (car p5) 10)(- (car (cdr p5)) 10)) "")

(command "dimradius" p9 (list (+ (car p1) 20)(+ (car (cdr p1)) 20)) "")

 

(command "layer" "s" "Рамка_штамп" "")

(command "ortho" "off")

 

(command "insert" "Штамп" "292,5" 1 1 0)

 

);конец функции

 

(load "Val")

(command "cmdecho" 0)

snap

off

osnap

off

layer

s

Рамка_штамп

 

rectangle

0,0

297,210

layer

s

 

rectangle

20,5

292,205

zoom

w

0,0

297,210

Val

 

Date: 2015-12-12; view: 366; Нарушение авторских прав; Помощь в написании работы --> СЮДА...



mydocx.ru - 2015-2024 year. (0.006 sec.) Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав - Пожаловаться на публикацию