批量分图
;;; Revised on 20200328(defun c:PLFT (/ dwgpath tkname attname ss num sslen
ent1 p1 p2 attobj attlen attnum
att tagstr ssf osm PATH
)
(vl-load-com)
(command "undo" "be")
;;(command "audit" "y")
(alert "批量分图0.3 请注意: 1. 不同图框里的图号不能重名2. 当前图纸目录下不能有与待分图名称相同的CAD文件,如有请删除!!!")
(setq cl (getvar "clayer"))
(command "-layer" "s" "0" "")
(setq osm (getvar "osmode"))
(setq lts (getvar "LTSCALE"))
(Setvar "cmdecho" 0)
(setvar "osmode" 0)
(Setvar "LTSCALE" 10)
(command "ucs" "w")
(setvar "filedia" 0)
(setq dwgpath (getvar "dwgprefix"))
;(alert "请选取图框:")
;(setq tkname (cdr (assoc 2 (entget (car (entsel))))))
(setq tkname"PLFT BLOCK")
;(alert "请选取图号属性物体:")
;(setq attname (cdr (assoc 2 (entget (car (nentsel))))))
(setq attname "DRAWINGNO")
;(alert "请选取批量输出的范围:")
(setq ss (ssget '((-4 . "<AND")(0 . "Insert")(2 . "PLFT BLOCK")(-4 . "AND>"))))
(setq num 0)
(setq sslen (sslength ss))
(while (< num sslen)
(setq ent1 (vlax-ename->vla-object (ssname ss num)))
(if (= (vlax-get ent1 'Name) tkname)
(progn
(vla-getboundingbox ent1 'p1 'p2)
(setq p1 (vlax-safearray->list p1))
(setq p2 (vlax-safearray->list p2))
(setq attobj (vlax-safearray->list (vlax-variant-value (VLA-GETATTRIBUTES ent1))))
(setq attlen (length attobj))
(setq attnum 0)
(while (< attnum attlen)
(setq att (nth attnum attobj))
(setq tagstr (vlax-get att 'TagString))
(if (= tagstr attname)
(progn
(setq dwgname (vlax-get att 'TextString))
(setq attnum attlen)
)
)
(setq attnum (1+ attnum))
)
(setq dwgname (strcat dwgpath dwgname))
(command "zoom" "e")
(command "limits" "0,0" (list (- (nth 0 p2) (nth 0 p1)) (- (nth 1 p2) (nth 1 p1))))
(setq ssf (ssget "C" p1 p2))
(command "move" ssf "" p1 "0,0,0")
(command "zoom" (getvar "limmin") (getvar "limmax"))
(command "采用wblock" dwgname "" "0,0" ssf "")
(command "oops")
(command "move" ssf "" "0,0" p1)
)
)
(setq num (1+ num))
)
(setvar "filedia" 1)
(command "undo" "end")
(command "-layer" "s" CL "")
(setvar "osmode" osm)
(Setvar "LTSCALE" lts)
(setq commands "ggkj" PATH "C:/cadtools/Automatic.scr")
;(alert "分图完成!!!")
; (load "automatic.fas")
(init-1)
( PROCESS-1)
)
;更改空间
(defun c:ggkj (/ ss1 ent1 tb tbs p1 p2 p2a p3 p2x p2y)
;更改空间的图块
(setq ss1 (ssget "x" '((0 . "Insert")(-4 . "<or")(2 . "FAB采用TITLE")(2 . "FAB DWG REVISION")(2 . "FAB采用TAB")(2 . "Inhabit(7147)-A1(eng hk)")(2 . "DRAWING TITLE")(2 . "F004-Title采用Block")(2 . "A030-Title采用Block")(2 . "DRAWING NO采用1")(2 . "A$C57FB4FFD")(2 . "Rev-List")(2 . "fab-tb2")(-4 . "or>"))))
(setq tb (ssget "x" '((-4 . "<AND")(0 . "Insert")(2 . "PLFT BLOCK")(-4 . "AND>"))))
(setq tbs (cdr (assoc 41 (entget (ssname TB 0)))))
(setq ent1 (vlax-ename->vla-object (ssname TB 0)))
(vla-getboundingbox ent1 'p1 'p2)
(setq p1 (vlax-safearray->list p1))
(setq p2 (vlax-safearray->list p2))
(setq p2x(/(car P2)TBS))
(setq p2Y(/(cadr P2)TBS))
(setq p2a(list p2x p2y 0))
(setq p3(list (- 0 p2Y) 0 0))
(setvar "TILEMODE" 0)
(command "mview""0,0" p2a ".MSPACE" "zoom" "w" "0,0" p2 )
(command ".chspace" ss1 "")
(VL-CMDF "MVIEW" "L" "on" "all" "")AP
(if (< p2x p2y)
(command "rotate" "all" "" p1 90 "move" "all" "" p3 p1)
)
)
(defun SDIR-1 (/ dwgname dwgname1)
(setq num 0)
(setq sslen (sslength ss))
(while (< num sslen)
(setq ent1 (vlax-ename->vla-object (ssname ss num)))
(if (= (vlax-get ent1 'Name) tkname)
(progn
(setq attobj (vlax-safearray->list
(vlax-variant-value (VLA-GETATTRIBUTES ent1))
)
)
(setq attlen (length attobj))
(setq attnum 0)
(while (< attnum attlen)
(setq att (nth attnum attobj))
(setq tagstr (vlax-get att 'TagString))
(if (= tagstr attname)
(progn
(setq dwgname (STRCAT (vlax-get att 'TextString) ".dwg"))
(setq attnum attlen)
)
)
(setq attnum (1+ attnum))
)
)
)
(setq num (1+ num))
(if (= dwgname1 "")
(progn
(SETQ dwgname (list dwgname))
(setq dwgname1 dwgname)
)
(setq dwgname1 (cons dwgname dwgname1))
)
)
(SETQ X (cons dwgpath dwgname1))
)
(setq dwgpath nil
F nil
FL nil
F1 nil
X nil
scrfile nil)
;init-1ialize
(defun init-1()
(SDIR-1)
(setq dwgpath (car X))
(setq X (acad采用strlsort (cdr X)))
(setq n2 (rtos (length X) 2 0)
n1 "1")
(if (= n2 1)
(setq dwgs "Drawing")
(setq dwgs "Drawings"))
)
(defun PROCESS-1 (/ SCRFILE DMSG)
(setq SCRFILE (open PATH "W"))
;(setq SCRFILE (open "Automatic1.scr" "W"))
(write-line
(strcat
"(dos采用getprogress
\"Automatic "
N2
" "
DWGS
" selected total \"
\"The Selected files is being progress, Please wait...\" "
N2
")"
)
SCRFILE
)
(write-line "(setvar \"cmddia\" 0)" SCRFILE)
(foreach DWGFILE X
;(write-line "(load \"Automatic.lsp\")" SCRFILE)
;(write-line (strcat "(AP采用OPENP \" DWGPATH DWGFILE " \ ")") SCRFILE)
(if (= CHKSDI 1)
(write-line (strcat "open y \"" DWGPATH DWGFILE "\"") SCRFILE)
(write-line (strcat "open \"" DWGPATH DWGFILE "\"") SCRFILE)
)
;(write-line "DGNPURGE PU ZOOM E" SCRFILE)
(write-line commands SCRFILE)
(write-line "(dos采用getprogress -1)" SCRFILE)
(if (= N1 N2)
(progn (write-line "(dos采用getprogress t)" SCRFILE)
(write-line
(strcat "(dos采用msgbox \""
N2
" Drawing(s) has been PROCESS-1.\" \"PROCESS-1\" 1 3 5)"
)
SCRFILE
)
)
)
(setq N1 (rtos (+ 1 (atoi N1)) 2 0))
(write-line ".CLOSE n" SCRFILE)
)
(write-line "(setvar \"cmddia\" 1)" SCRFILE)
(close SCRFILE)
(command "script" PATH)
)
(princ)
页:
[1]