Педлагам програмка за изчертаване на рамка на чертежа в LAYOUT в зависимост от размера на предварително настроен PAGE SETUP, като оставя свободно поле, рамката е с опашка за прикачване към папка с машинка и знаци за сгъване



(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))
(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")
); L> 395
);cond
(entdel solid)
(if (> (cadr pt2)295)
(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

Запишете програмата като файл "GET-LAYOUT.LSP" в директория "SUPPORT", заредете го с
(lLOAD "GET-LAYOUT")

Изберете LAYOUT, изберете плотер, размер на страницата (може и CUSTOM), ориентация (Portrait или Landscape) след това стартирайте програмата с

(GET-LAYOUT)

това е всичко