Schöck
Показать сообщение отдельно
Непрочитано 20.09.2006, 21:13 #1
Создание форматки для СПДС
Владимир М
 
-
 
Ухта
Регистрация: 31.07.2005
Сообщений: 380

Вот и для СПДС форматка на базе кода Дениса Флюстикова. Тестировал работает с 2004, но на 2002 каде вылетает может кто-нибудь поправит меня, чтобы этого не происходило.
А вот код:
Код:
[Выделить все]
;Текст файла Format_MV.lsp:

(defun Format_MV ()

(if (= x3 1)
(setq a1 '(("Фамилия" (-160 31) 18 3 0 1);Разраб.
("Фамилия" (-160 26) 18 3 0 1);Пров.
("Фамилия" (-160 11) 18 3 0 1);Н.контр.
("Фамилия" (-160 6) 18 3 0 1);Утв.
("ОАО \"Название\"" (-30 10) 118 5 0 1);название учреждения
("1" (-15 23.75) 10 3 0 1);Листов
("Объект" (-65 41.25) 118 2.5 0 1)
("Название \(строка1\)" (-90 31.25) 68 2.5 0 1)
("Название \(строка2\)" (-90 26.25) 68 2.5 0 1)
("Название \(строка3\)" (-90 21.25) 68 2.5 0 1)
("Материал" (-90 10.5) 68 4 0 1)
("1.*Размеры для справок." (-185 90) 119 4 0 0)
("2. Остальные ТТ." (-185 83) 119 4 0 0)
)
a1 (append a1 (list (list "АБВГ." ;Пеpв. пpимен.
(mapcar '- '(-65 52) (list 0 0))
118 6 0 1))))
(setq a1 (list '("АБВГ." (-65 9.5) 118 6 0 1);Обозначение
(list (itoa x3) '(-10 7.5) 8 3 0 1);Лист
)))


(repeat (length a1)

(setq a2 (car a1)
a1 (cdr a1)
f1 (nth 2 a2)
f2 (cdr(assoc 41 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
a2 (list '(0 . "TEXT")
(cons 40 (nth 3 a2));Высота
(cons 8 layer);
'(6 . "Continuous");
'(62 . 1);Цвет
(cons 370 (/ lineweight 2))
(cons 50 (* pi (nth 4 a2)));Поворот
(cons 41 f2);Сжатие
(cons 51 (cdr(assoc 50 (tblsearch "STYLE" (getvar "TEXTSTYLE")))));Наклон
(cons 10 (trans (nth 1 a2) 1 0));
(cons 72 (nth 5 a2));Выравнивание 0-лево, 1-центр
'(73 . 0);
(cons 11 (trans (nth 1 a2) 1 0))
(cons 1 (nth 0 a2));Текст
(cons 7 textstyle);Стиль
)
f1 (/ f1 (caadr (textbox a2))))

(if (< f1 1)
(setq f2 (* f2 f1)
a2 (subst (cons 41 f2) (assoc 41 a2) a2)))

(entmake a2)
)
)

(defun Format_MV_1 ()

(if (= x2 3)(setq x2 1))

(if (and (/= x2 0)(= x 0)(= x1 0))
(setq x2 2))

(start_list "x1")
(MAPCAR 'ADD_LIST (nth x a1))
(end_list)
(set_tile "x1" (itoa x1))

(start_image "x2")
(fill_image 0 0 300 22 9)
(end_image)
(set_tile "x2" (nth x2 '(" Ориентация" "Горизонтально" " Вертикально" )))

(start_image "x3")
(fill_image 0 0 150 22 9)
(end_image)
(set_tile "x3" (strcat " Лист " (itoa x3)))

)

(defun c:Format_MV (/ a1 a2 f1 f2 s x x1 x2 x3 layer lineweight textstyle)

(setq layer "0" ;Слой
lineweight 50 ;Толщина основной линии
textstyle "Standard-DEN");Текстовый стиль

(if (null (tblsearch "STYLE" textstyle))
(setq textstyle (getvar "TEXTSTYLE")))

(if (findfile "Format_MV.dcl")
(progn
(setq DCL_ID (load_dialog "Format_MV.dcl"))
(setq x 0)
(setq x1 0)
(setq x2 0)
(setq x3 1)
(if (not (new_dialog "Format_MV" DCL_ID))
(exit))

(setq a1 '(("1" "3" "4" "5" "6" "7" "8" "9")("1" "3" "4" "5" "6" "7")
("1" "3" "4" "5")("1" "3" "4")("1" "2" "3")))

(Format_MV_1)

(action_tile "x" "(setq x (atoi $value) x1 0)(if (= x2 0)(setq x2 (1+ x2)))(Format_MV_1)")
(mode_tile "x" 2)
(action_tile "x1" "(setq x1 (atoi $value))(if (= x2 0)(setq x2 (1+ x2)))(Format_MV_1)")
(action_tile "x2" "(if (/= x2 0)(setq x2 (1+ x2)))(Format_MV_1)")
(action_tile "x3" "(setq x3 (1+ x3))(Format_MV_1)")

(action_tile "accept" "(done_dialog)(setq s T)")
(action_tile "cancel" "(done_dialog)(setq s nil)")
(start_dialog)

)
(UNLOAD_DIALOG DCL_ID)
)

(if (= s T)(progn

(vl-load-com)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setvar "CMDECHO" 0)

(setq f1 '((210 297 297 297 297 297 297 297)
(297 420 420 420 420 420)
(420 594 594 594)
(594 841 841)
(841 1189 1189))
f1 (nth x1 (nth x f1))
f2 '((297 630 841 1051 1261 1471 1682 1892)
(420 891 1189 1486 1783 2080)
(594 1261 1682 2102)
(841 1783 2378)
(1189 1682 2523))
f2 (nth x1 (nth x f2)))

(if (/= x1 0)
(setq x1 (strcat "x" (nth x1 (nth x a1))))
(setq x1 ""))

(setq x1 (strcat "Формат " (nth x '("A4" "A3" "A2" "A1" "A0")) x1)
x1 (cons x1 '((-47 1) (-21 1))))

(if (= x2 1)
(setq s f1 f1 f2 f2 s))

(setq s (entlast)
a1 (list '(-5 5) (mapcar '- '(20 5) (list f1 0))
(mapcar '- '(20 5) (list f1 0)) (mapcar '- '(20 -5) (list f1 (- f2)))
(mapcar '- '(20 -5) (list f1 (- f2))) (mapcar '+ '(-5 -5) (list 0 f2))
(mapcar '+ '(-5 -5) (list 0 f2)) '(-5 5)
))

(if (or (= x 0)(= x2 1))(progn

(setq a2 '((0 0) (0 0) ; Верх.рамка

))

(if (= x3 1)
(setq a2 (append a2 '((0 0) (0 0) ; Верт.рамка дополн.поля

))))

(repeat (length a2)
(setq a1 (append a1 (list (mapcar '- (car a2) (list f1 (- f2)))))
a2 (cdr a2)))
)(progn

(setq a2 '((0 0) (0 0) ; Гориз.рамка в вертик

))

(if (= x3 1)
(setq a2 (append a2 '((0 0) (0 0) ; Гориз.рамка дополн.поля

))))

(repeat (length a2)
(setq a1 (append a1 (list (mapcar '+ (car a2) (list 0 f2))))
a2 (cdr a2)))
))

(setq a2 '((20 5) (8 5)
(20 30) (8 30)
(20 65) (8 65)
(20 90) (8 90)
(13 5) (13 90)
(8 5) (8 90)
))

(if (= x3 1)
(setq a2 (append a2 '((20 90) (0 90)
(20 110) (5 110)
(20 130) (5 130)
(20 145) (20 145)
(20 155) (0 155)
(5 90) (5 155)
(10 90) (10 155);дополн.поля для рамки согласовки
     (15 90) (15 155)
))))

(repeat (length a2)
(setq a1 (append a1 (list (mapcar '- (car a2) (list f1 0))))
a2 (cdr a2)))

(if (= x3 1)
(setq a2 '((-190 5) (-190 60)
     (-190 60) (-5 60)
     (-190 40) (-125 40)
     (-190 35) (-125 35)
     (-180 60) (-180 35)
     (-170 60) (-170 5)
     (-160 60) (-160 35)
     (-150 60) (-150 5)
     (-135 60) (-135 5)
     (-125 60) (-125 5)
     (-55 35) (-55 5)
     (-40 35) (-40 20)
     (-25 35) (-25 20)
     (-55 30) (-5 30)
     (-125 50) (-5 50)
     (-125 20) (-5 20)
     (-125 35) (-5 35)
))
(setq a2 '((-190 5) (-190 20)
     (-190 20) (-5 20)
     (-180 5) (-180 20)
     (-170 5) (-170 20)
     (-160 5) (-160 20)
     (-150 5) (-150 20)
     (-135 5) (-135 20)
     (-125 5) (-125 20)
     (-15 5) (-15 20)
     (-190 10) (-125 10)
     (-15 13) (-5 13)
)))

(setq a1 (append a1 a2))

(repeat (/ (length a1) 2)
(entmake (list '(0 . "LINE")
(cons 8 layer)
'(6 . "Continuous")
'(62 . 7)
(cons 370 lineweight)
(cons 10 (trans (car a1) 1 0))
(cons 11 (trans (cadr a1) 1 0))
))
(setq a1 (cddr a1))
)

(if (= x3 1)
(setq a1 '((-190 55) (-125 55)
     (-190 50) (-125 50)
     (-190 45) (-125 45)
     (-190 30) (-125 30)
     (-190 25) (-125 25)
     (-190 20) (-125 20)
     (-190 15) (-125 15)
     (-190 10) (-125 10)
))
(setq a1 '((-190 15) (-125 15)
)))

(setq a1 (append a1 (list '(0 0) (list (- f1) 0)
(list (- f1) 0) (list (- f1) f2)
(list (- f1) f2) (list 0 f2)
(list 0 f2) '(0 0)
)))

(repeat (/ (length a1) 2)
(entmake (list '(0 . "LINE")
(cons 8 layer)
'(6 . "Continuous")
'(62 . 7)
(cons 370 (/ lineweight 2))
(cons 10 (trans (car a1) 1 0))
(cons 11 (trans (cadr a1) 1 0))
))
(setq a1 (cddr a1))
)

(if (= x3 1)
(setq a1 '(("Изм." (-188.38 36.25) (-181.62 36.25))
     ("Кол.уч." (-178.94 36.25) (-171.06 36.25))
     ("Лист" (-169.04 36.25) (-160.94 36.25))
     ("N%%d док." (-158.95 36.25) (-151.05 36.25))
     ("Подп." (-146.75 36.25) (-138.25 36.25))
     ("Дата" (-134.05 36.25) (-125.95 36.25))
     ("Разраб." (-189 31) (-174 31))
     ("Пров." (-189 26) (-179 26))
     ("Т.контр." (-189 21) (-174 21))
     ("Н.контр." (-189 11) (-174 11))
     ("Утв." (-189 6) (-181 6))
     ("Стадия" (-53.44 31.25) (-41.56 31.25))
     ("Лист" (-36.54 31.25) (-28.46 31.25))
     ("Листов" (-20.88 31.25) (-9.12 31.25))
     ("Копировал" (-117 1) (-96 1))
))
(setq a1 '(("Изм." (-188.38 6.25) (-181.62 6.25))
("Кол.уч." (-178.94 6.25) (-171.06 6.25))
("Лист" (-169.04 6.25) (-160.94 6.25))
("N%%d док." (-158.95 6.25) (-151.05 6.25))
("Подп." (-146.75 6.25) (-138.25 6.25))
("Дата" (-134.05 6.25) (-125.95 6.25))
("Лист" (-14 15) (-6 15))
("Копировал" (-117 1) (-96 1))
)))

(setq a1 (append a1 (list x1))
a2 '(("Инв. N%%d подл." (12 9) (12 26))
     ("Подп. и дата" (12 34.98) (12 60.02))
     ("Взам. инв. N%%d" (12 67.9) (12 87.1))
))

(if (= x3 1)
(setq a2 (append a2 '(("Согласовано" (3.88 92) (3.38 116.74))

))))

(repeat (length a2)
(setq a1 (append a1 (list (list (caar a2)
(mapcar '- (cadar a2) (list f1 0))
(mapcar '- (caddar a2) (list f1 0))
)))
a2 (cdr a2)))

(repeat (length a1)
(entmake (list '(0 . "TEXT")
'(40 . 3)
(cons 8 layer)
'(6 . "Continuous")
'(62 . 7)
(cons 370 (/ lineweight 2))
'(51 . 0)

(cons 10 (trans (nth 1 (car a1)) 1 0))
'(72 . 5)
'(73 . 0)
(cons 11 (trans (nth 2 (car a1)) 1 0))
(cons 1 (nth 0 (car a1)))
(cons 7 textstyle)
))
(setq a1 (cdr a1))
)

(Format_MV);Рамка

(setq a2 (ssadd))

(if s
(setq s (entnext s))
(setq s (entnext)))

(while s
(setq a2 (ssadd s a2)
s (entnext s)))

(setq s "temp")

(while (/= (tblsearch "block" s) nil)
(setq s (strcat s "1")))

(command "._block" s '(0 0 0) a2 "")

(if (vl-cmdf "._insert" s pause)(progn

(while (= (getvar 'cmdactive) 1)
(command ""))

(setq a1 (getvar "explmode"))
(setvar "explmode" 1)
(command "_.explode" (entlast))
(setvar "explmode" a1)
))

(vla-Delete (vla-Item (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object))) s))

(setvar "CMDECHO" 1)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
))
(princ)
)
Просмотров: 4507
 
Размещение рекламы