전체 소스는 태은님꺼 입니다. 다시한번 태은님께 감사 드립니다.
전 밥숱깔만...올렸음.... 공부용으론 쵝오...일꺼 같아... 올려 봅니다.
사용법은 도곽(블럭)의 최외각을 선택한 다음 도면이름으로 할 택스트 구역을 을 선택하면 됩니다.ㅎㅎㅎ
(defun c:aa
( / bgp cad doc sets OOv ls cp j k o p1 p2 p3 p4 dir view xsc ysc zsc ip xdi ydi xxdi yydi ssX
_Error
_Lwpoly
_pt->lst
_ScreenPoint
_Doc
_Start
_End
_Objects
_Z20
_Open
_Obj2ssX
_UnFormat
_PDFplotting
*error*
)
(defun *error* (s) (if OOv (_End OOv)) (setvar 'backgroundplot bgp) (princ s))
(defun _UnFormat ( str mtx / _Replace regex )
(defun _Replace ( new old str )
(vlax-put-property regex 'pattern old) (vlax-invoke regex 'replace str new)
)
(setq regex (vlax-get-or-create-object "VBScript.RegExp"))
(mapcar
(function
(lambda ( x ) (vlax-put-property regex (car x) (cdr x)))
)
(list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue))
)
(mapcar
(function
(lambda ( x ) (setq str (_Replace (car x) (cdr x) str)))
)
'(
("Ð" . "\\\\\\\\")
(" " . "\\\\P|\\n|\\t")
("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
("$1" . "[\\\\]({)|{")
)
)
(setq str
(if mtx
(_Replace "\\\\" "Ð" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
(_Replace "\\" "Ð" str)
)
)
(vlax-release-object regex)
str
)
(defun _lwpoly ( lst cls )
(vlax-ename->vla-object
(entmakex
(append
(list
(cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline") (cons 90 (length lst))
(cons 70 cls)
)
(mapcar '(lambda (p) (cons 10 p))lst)
)
)
)
)
(defun _pt->lst ( p1 p2 )
(list p1 (list (car p1) (cadr p2)) p2 (list (car p2) (cadr p1)))
)
(defun _ScreenPoint ( lst / v )
(setq v
(list
(* (/ (getvar 'VIEWSIZE) 2.0) (apply '/ (getvar 'SCREENSIZE)))
(/ (getvar 'VIEWSIZE) 2.0)
0.
)
)
(if lst (vlax-invoke (vlax-get-acad-object) 'ZoomWindow (car lst) (cadr lst)))
(list
(trans (mapcar '- (getvar 'VIEWCTR) v) 1 0)
(trans (mapcar '+ (getvar 'VIEWCTR) v) 1 0)
)
)
(defun _start( lst / doc )
(setq doc (_end nil))
(vla-startundomark doc)
(list lst (mapcar 'getvar lst))
)
(defun _end ( d / doc )
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(and (cadr d) (mapcar 'setvar (car d) (cadr d)))
(if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-endundomark doc)) doc
)
(defun _objects ( ss / i re )
(if ss
(repeat (setq i (sslength ss))
(setq re (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) re))
)
)
)
(defun _Z20 ( p ) (list (car p) (cadr p) 0.))
(defun _Open ( target / shell result )
(if (wcmatch target "*\\") (setq target (vl-string-right-trim "\\" target)))
(if (wcmatch target "*/") (setq target (vl-string-right-trim "/" target)))
(if
(and
(or
(eq 'INT (type target))
(setq target (findfile target))
)
(setq shell (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))
)
(progn
(setq result (vl-catch-all-apply 'vlax-invoke (list shell 'open target)))
(vlax-release-object shell)
(not (vl-catch-all-error-p result))
)
)
)
(defun _Obj2ssX ( sets objs / ss )
(vl-catch-all-apply 'vla-add (list sets "ss"))
(setq ss (vla-item sets "ss"))
(vla-clear ss)
(vlax-invoke ss 'additems objs)
ss
)
(defun _Error ( mi ma co / o w )
(setq o (_Lwpoly (_pt->lst mi ma) 1)
w (* 0.15 (abs (- (cadr ma) (cadr mi))))
)
(vla-put-color o co)
(vla-setwidth o 0 w w)
(vla-setwidth o 1 w w)
(vla-setwidth o 2 w w)
(vla-setwidth o 3 w w)
)
(defun _PDFplotting (p1 p2 FileName / list->variant acDoc ActLay PlotObj plotter ctb paper p1 p2)
(defun list->variant (lst vartype)
; By Frank Oquendo
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vartype (cons 0 (1- (length lst))))
lst
)
)
)
(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
ActLay (vla-get-ActiveLayout AcDoc) ;;모형 or layout
PlotObj (vla-get-plot AcDoc)
)
(setq plotter "DWG To PDF.pc3"
ctb "monochrome.ctb"
paper "ISO_A3_(297.00_x_420.00_MM)"
);plot설정
(setq p1 (trans p1 0 2)
p2 (trans p2 0 2)
)
(setq p1 (list->variant (setq aa (list (car p1) (cadr p1))) vlax-vbDouble)
p2 (list->variant (setq bb (list (car p2) (cadr p2))) vlax-vbDouble)
)
(vla-setWindowToPlot ActLay p1 p2)
(vla-put-PlotType ActLay acWindow)
(vlax-invoke-method ActLay 'RefreshPlotDeviceInfo)
(vla-put-Configname ActLay plotter) ;
(vla-put-CanonicalMediaName ActLay paper) ;
(vla-put-PaperUnits ActLay 1) ; 0:inch 1: millimeter
(vla-put-PlotRotation ActLay 1) ; 0:세로 1: 가로
(vla-put-StandardScale ActLay acScaleToFit)
(vla-put-UseStandardScale ActLay :vlax-true) ;
(vla-put-CenterPlot ActLay :vlax-true) ; true: 간격띄우기(plot중심)
(vla-put-PlotWithPlotStyles ActLay :vlax-true) ;
(vla-put-StyleSheet ActLay ctb) ;
(vla-put-PlotHidden ActLay :vlax-false) ; true:기존와이어프레임
(vla-put-NumberOfCopies PlotObj 1) ;수량
(vla-plottofile PlotObj (strcat FileName ".pdf"))
)
(or
(= 1 (getvar 'DWGTITLED))
(alert "\n먼저 도면을 저장하세요.")
(exit)
)
(setq cad (vlax-get-acad-object)
doc (vla-get-activedocument cad)
sets (vla-get-selectionsets doc)
bgp (getvar 'backgroundplot)
OOv (_Start '(DIMSCALE LTSCALE))
ls (/ (getvar 'LTSCALE) (getvar 'DIMSCALE))
cp '(0. 0. 0.)
j 0
k 0
)
(setvar 'backgroundplot 0)
(command "_.ucs" "_w")
(if
(and
(setq o (vlax-ename->vla-object (car (entsel "\nSelect Title Block : "))))
(setq p1 (getpoint "\nSpecify point : "))
(setq p2 (getcorner p1))
(setq p3 (getpoint "\nDrawing Name point : "))
(setq p4 (getcorner p3))
(setq dir (strcat (getvar 'DWGPREFIX) (rtos (getvar 'CDATE) 2 8) "\\"))
)
(progn
(vl-mkdir dir)
(setq view (_ScreenPoint nil)
ip (vlax-get o 'InsertionPoint)
xsc (vla-get-xscalefactor o)
ysc (vla-get-yscalefactor o)
zsc (vla-get-zscalefactor o)
xdi (mapcar '/ (mapcar '- p1 ip) (list xsc ysc zsc))
ydi (mapcar '/ (mapcar '- p2 ip) (list xsc ysc zsc))
xxdi (mapcar '/ (mapcar '- p3 ip) (list xsc ysc zsc))
yydi (mapcar '/ (mapcar '- p4 ip) (list xsc ysc zsc))
)
(mapcar
'(lambda ( o / mi ma xsc ysc zsc ip p1 p2 p3 p4 ss o2 n dwg dxf pdf l wos )
(vla-getboundingbox o 'mi 'ma)
(setq mi (_Z20 (vlax-safearray->list mi))
ma (_Z20 (vlax-safearray->list ma))
xsc (vla-get-xscalefactor o)
ysc (vla-get-yscalefactor o)
zsc (vla-get-zscalefactor o)
ip (vlax-get o 'InsertionPoint)
p1 (mapcar '+ ip (mapcar '* xdi (list xsc ysc zsc)))
p2 (mapcar '+ ip (mapcar '* ydi (list xsc ysc zsc)))
p3 (mapcar '+ ip (mapcar '* xxdi (list xsc ysc zsc)))
p4 (mapcar '+ ip (mapcar '* yydi (list xsc ysc zsc)))
)
(setvar 'DIMSCALE xsc)
(setvar 'LTSCALE (* ls xsc))
(vlax-invoke cad 'ZoomWindow mi ma)
(if (setq ss (ssget "_cp" (_pt->lst p3 p4) '((0 . "TEXT,MTEXT"))))
(progn
(setq o2 (vlax-ename->vla-object (ssname ss 0)))
(if (= (vla-get-objectname o2) "AcDbMText")
(setq n (_UnFormat (vla-get-textstring o2) nil))
(setq n (vla-get-textstring o2))
)
(setq dwg (strcat dir n ".dwg")
dxf (strcat dir n ".dxf")
pdf (strcat dir n ".pdf")
l (_pt->lst (trans mi 0 1) (trans ma 0 1))
)
(cond
( (or (= n "") (findfile dwg) (findfile dxf)(findfile pdf))
(_Error mi ma 1)
(setq j (1+ j))
)
( (setq wos (cons o (_Objects (ssget "_wp" l))))
(_Error mi ma 3)
(foreach o wos (vlax-invoke o 'move mi cp))
(vlax-invoke cad 'ZoomWindow cp (mapcar '- ma mi))
(setq ssX (_Obj2ssX sets wos))
(vla-wblock doc dwg ssX);dwg내보내기
(vla-export doc (strcat dir n) "dxf" ssX);dxf내보내기
(_PDFplotting cp (mapcar '- ma mi) (strcat dir n));pdf내보내기
(foreach o wos (vlax-invoke o 'move cp mi))
(setq k (1+ k))
)
)
)
(progn
(_Error mi ma 2)
(setq j (1+ j))
)
)
)
(_Objects (ssget (list '(0 . "INSERT") (cons 2 (vla-get-name o)))))
)
)
) (_End nil)
(vlax-invoke cad 'ZoomWindow (car view) (cadr view))
(if (> j 0)
(princ (strcat (itoa j) "EA 도면에서 에러가 발생함 (중복된 파일이름 or 파일명이 입력되지 않았음"))
(princ (strcat (itoa k) "EA 도면 내보내기 성공"))
)
(if (> k 0) (_Open dir))
(princ)
(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acAllviewports)
(setvar 'backgroundplot bgp)
)(vl-load-com)
도면나누기 vl-.lsp