|
Тема |
Re: Въпрос за Layouts [re: tooth] |
|
Автор | StSt (Нерегистриран) | |
Публикувано | 01.12.06 08:42 |
|
|
Пращам ти програма за направа рамка на чертежа в Layouts.
Предполагам, че това ти трябва.
Запиши я като GET-LAYOUT.LSP. Сложи я в Support. Зареди я с LoadApplication.
Стартирай я с
(GET-LAYOUT)
;ВАДИ ДАННИТЕ НА LAYOUT ОТ PGESETUP И ЧЕРТАЕ ПОЛИЛИНИЯ ПО ГРАНИЦИТЕ
(DEFUN GET-LAYOUT (/ OLSOMODE LAY PT1 PT2 PTI ROT INCH LW LH DL DR DB DT ENTLAY br br1 dob ptend )
(VL-LOAD-COM)
(SETQ OLSOMODE (GETVAR "OSMODE"))
(SETVAR "OSMODE" 16845)
(setq LAY(HANDENT(vla-get-Handle(vla-get-layout(vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object))))))
ENTLAY (ENTGET LAY)
);setq
(if(not(VL-STRING-SEARCH "NONE" (STRCASE(cdr(ASSOC 2 ENTLAY)))))
(PROGN
(setq
PT1 (CDR(ASSOC 10 ENTLAY))
PTI (LIST (CDR(ASSOC 46 ENTLAY))(CDR(ASSOC 47 ENTLAY)))
ROT (CDR(ASSOC 73 ENTLAY))
INCH(CDR(ASSOC 72 ENTLAY))
LW(CDR(ASSOC 44 ENTLAY))
LH(CDR(ASSOC 45 ENTLAY))
DL(CDR(ASSOC 40 ENTLAY))
DB(CDR(ASSOC 41 ENTLAY))
DR(CDR(ASSOC 42 ENTLAY))
DT(CDR(ASSOC 43 ENTLAY))
)
(IF (= INCH 0)(SETQ INCH 2.54))
(COND
((= ROT 1)
(SETQ PT2 (MAPCAR '+ PTI (LIST (- LH DT DB)(- LW DR DL))))
);=1
((= ROT 0)
(SETQ PT2 (MAPCAR '+ PTI (LIST (- LW DR DL) (- LH DT DB))))
);=0
((= ROT 3)
(SETQ PT2 (MAPCAR '+ PTI (LIST (* -1(- LH DT DB))(* -1(- LW DR DL)))))
);=3
);COND
(if (and
(setq nab (ssget"c" PTI (MAPCAR '+ PTI '(0.1 0.1) )))
);and
(COMMAND "erase" nab (COMMAND))
);if
(COMMAND "RECTANGLE" (MAPCAR '+ PTI '(25 10)) (MAPCAR '+ PTI PT2 '(-10 -10)))
;(COMMAND "RECTANGLE" PTI (MAPCAR '+ PTI PT2 ))
;чертае рамка на чертежа
; (COMMAND "RECTANGLE" (MAPCAR '+ PTI '(20 10)) (MAPCAR '+ PTI PT2 '(-10 -10)))
(if (> (cadr pt2) 297.0)
(PROGN
(COMMAND "pline" pti
(MAPCAR '+ pti '(0 295.0))
(MAPCAR '+ pti '(20.0 295.0))
(MAPCAR '+ pti (list 20 (cadr pt2)))
(MAPCAR '+ PTI PT2 )
(MAPCAR '+ pti (list (car pt2) 0))
pti
"")
);PROGN
(COMMAND "RECTANGLE" PTI (MAPCAR '+ PTI PT2 ))
);if
(COMMAND "line" (mapcar '+ pti (list 0 (/ 295.0 2)))
(mapcar '+ pti (list 0 (/ 295.0 2))'(25 0))"")
(COMMAND "solid" '(-2 0) '(0 5) '(2 0) "" "")
(setq solid (entlast)dll 190)
(cond
((> (car pt2)(+ 210 dll))
(setq br (fix(* 2(/(fix(/ (-(car pt2) 210)dll))2.0)))
dop (-(car pt2)(* br dll)210)
i 1
ptend (list(+ (car pti)(car pt2)) (cadr pti))
br1 -2.0
)
(if (< dop 100)(setq br (1- br) dop (-(car pt2)(* br dll)210) ) )
(setq br1 (- br1 (rem br 2))nab (ssadd))
(if (> br 0)
(PROGN
(REPEAT br
(COMMAND "copy" solid "" '(0 0) (MAPCAR '- ptend (list (* i dll) 0)))
(setq i (1+ i)
nab (ssadd (entlast)nab))
);REPEAT
(COMMAND "copy" (entlast) "" '(0 0) (list (/ dop br1) 0))
(setq nab (ssadd (entlast)nab))
(COMMAND "copy" (entlast) "" '(0 0) (list (/ dop br1) 0))
(setq nab (ssadd (entlast)nab))
(if (= br1 -3.0)(COMMAND "copy" (entlast) "" '(0 0) (list (/ dop br1) 0)))
(setq nab (ssadd (entlast)nab))
(COMMAND "mirror" nab "" (mapcar '+ pti (mapcar '/ pt2 '(2 2)))
(mapcar '+ pti (mapcar '/ pt2 '(2 2))'(2 0))
"N")
));if br>0
); L> 395
);cond
(entdel solid)
(if (> (cadr pt2)297)
(PROGN
(COMMAND "solid" (MAPCAR '+ ptend '(0 -2))
(MAPCAR '+ ptend '(-5 0))
(MAPCAR '+ ptend '(0 2)) "" "")
(setq solid (entlast))
(COMMAND "array" solid "" "R"
(1+(fix (/ (cadr pt2)295.0)))
1
295.0
)
(entdel solid)
);PROGN
);if H>295
);PROGN
(ALERT "НЯМА ИЗБРАН ПЛОТЕР
\nОТ \"PAGE SETUP\" ИЗБЕРЕТЕ ПЛОТЕР, РАЗМЕР И ОРИЕНТАЦИЯ НА СТРАНИЦАТА\n
И ОТНОВО СТАРТИРАЙТЕ '(GET-LAYOUT)'")
);if not None plotter
(SETVAR "OSMODE" OLSOMODE)
);GET-LAYOUT
|
| |
|
|
|