|
|
| Тема |
 Re: Само рамка [re: StSt] |
|
| Автор |
magesnik (вълшебник) |
|
| Публикувано | 05.12.06 10:27 |
|
|
|
значи да не ми се смеете много, защото не разбирам кой знае от лисп
какво съм направил (всъщност редакцията не е кой знае каква):
опашката съм я махнал
преработил съм маркерите за сгъване - вместо триъгълни солиди използвам линии
лошото е че нещо "оцапах" вертикалните маркери в дясната част на листа - затова съм ги коментирал, че дава грешка...мисля че и без тях мога да си сгъвам чертежа ...
ето го и лиспа:
;ВАДИ ДАННИТЕ НА 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 '(20 5)) (MAPCAR '+ PTI PT2 '(-5 -5)))
(COMMAND "RECTANGLE" PTI (MAPCAR '+ PTI PT2 ))
;изчертаване на вертикален маркер в ляво
;;;(COMMAND "line" (mapcar '+ pti (list 0 (/ 295.0 2)))
;;;(mapcar '+ pti (list 0 (/ 295.0 2))'(20 0))"")
(COMMAND "line" '(0 295) '(20 295) "")
;изчертаване на хоризонтални маркери
(COMMAND "line" '(0 0) '(0 5) "")
(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
(ALERT "НЯМА ИЗБРАН ПЛОТЕР
\nОТ \"PAGE SETUP\" ИЗБЕРЕТЕ ПЛОТЕР, РАЗМЕР И ОРИЕНТАЦИЯ НА СТРАНИЦАТА\n
И ОТНОВО СТАРТИРАЙТЕ '(GET-LAYOUT)'")
);if not None plotter
(SETVAR "OSMODE" OLSOMODE)
);GET-LAYOUT
Магьосниците не закъсняват, нито идват по-рано. Те пристигат точно когато им е угодно
| |
| |
| 
|
|
