批量分图

jxmjg

1. ;;;   Revised on 20200328
3. (defun c:PLFT (/ dwgpath tkname         attname ss         num         sslen
4.                  ent1         p1         p2         attobj         attlen         attnum
5.                  att         tagstr         ssf         osm PATH
6.                 )
9.   (vl-load-com)
10. (command "undo" "be")
11. ;;(command "audit" "y")
12. (alert "批量分图0.3 请注意: 1. 不同图框里的图号不能重名  2. 当前图纸目录下不能有与待分图名称相同的CAD文件,如有请删除!!!")
13.   (setq cl (getvar "clayer"))
14.   (command "-layer" "s" "0" "")
15. (setq osm (getvar "osmode"))
16.   (setq lts (getvar "LTSCALE"))
17.   (Setvar "cmdecho" 0)
18.   (setvar "osmode" 0)
19.   (Setvar "LTSCALE" 10)
20.   (command "ucs" "w")
21. (setvar "filedia" 0)
22. (setq dwgpath (getvar "dwgprefix"))
23. ;(alert "请选取图框:")
24. ;(setq tkname (cdr (assoc 2 (entget (car (entsel))))))
25. (setq tkname  "PLFT BLOCK")
26. ;(alert "请选取图号属性物体:")
27. ;(setq attname (cdr (assoc 2 (entget (car (nentsel))))))
28. (setq attname "DRAWINGNO")
29. ;(alert "请选取批量输出的范围:")
31. (setq ss (ssget '((-4 . "<AND")(0 . "Insert")(2 . "PLFT BLOCK")(-4 . "AND>"))))
32. (setq num 0)
33. (setq sslen (sslength ss))
34.   
35. (while (< num sslen)
36.         (setq ent1 (vlax-ename->vla-object (ssname ss num)))
37.         (if (= (vlax-get ent1 'Name) tkname)
38.                 (progn
39.                         (vla-getboundingbox ent1 'p1 'p2)
40.                         (setq p1 (vlax-safearray->list p1))
41.                         (setq p2 (vlax-safearray->list p2))
43.                         (setq attobj (vlax-safearray->list (vlax-variant-value (VLA-GETATTRIBUTES ent1))))
44.                         (setq attlen (length attobj))
45.                         (setq attnum 0)
46.                         (while (< attnum attlen)
47.                                 (setq att (nth attnum attobj))
48.                                 (setq tagstr (vlax-get att 'TagString))
49.                                 (if (= tagstr attname)
50.                                         (progn
51.                                         (setq dwgname (vlax-get att 'TextString))
52.                                         (setq attnum attlen)
53.                                         )
54.                                 )
55.                                 (setq attnum (1+ attnum))
56.                         )
58.                         (setq dwgname (strcat dwgpath dwgname))
59.                        
60.                         (command "zoom" "e")
61.                         (command "limits" "0,0" (list (- (nth 0 p2) (nth 0 p1)) (- (nth 1 p2) (nth 1 p1))))
62.                        
63.                         (setq ssf (ssget "C" p1 p2))
64.                         (command "move" ssf "" p1 "0,0,0")
65.                         (command "zoom" (getvar "limmin") (getvar "limmax"))
67.                         (command "采用wblock" dwgname "" "0,0" ssf "")
68.                         (command "oops")
69.                         (command "move" ssf "" "0,0" p1)
70.                 )
71.         )
72.         (setq num (1+ num))
73. )
74. (setvar "filedia" 1)
75. (command "undo" "end")
76.   (command "-layer" "s" CL "")
77.   (setvar "osmode" osm)
78.   (Setvar "LTSCALE" lts)
79.   (setq commands "ggkj" PATH "C:/cadtools/Automatic.scr")
80. ;(alert "分图完成!!!")
81. ; (load "automatic.fas")
82.   (init-1)
83. ( PROCESS-1)
85. )
88. ;更改空间
89. (defun c:ggkj (/ ss1 ent1 tb tbs p1 p2 p2a p3 p2x p2y)
91. ;更改空间的图块
92. (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>"))))
94. (setq tb (ssget "x" '((-4 . "<AND")(0 . "Insert")(2 . "PLFT BLOCK")(-4 . "AND>"))))
95. (setq tbs (cdr (assoc 41 (entget (ssname TB 0)))))
96. (setq ent1 (vlax-ename->vla-object (ssname TB 0)))
97. (vla-getboundingbox ent1 'p1 'p2)
98. (setq p1 (vlax-safearray->list p1))
99. (setq p2 (vlax-safearray->list p2))
100. (setq p2x(/(car P2)TBS))
101. (setq p2Y(/(cadr P2)TBS))
102. (setq p2a(list p2x p2y 0))
103. (setq p3(list (- 0 p2Y) 0 0))
104. (setvar "TILEMODE" 0)
105. (command "mview"  "0,0" p2a ".MSPACE" "zoom" "w" "0,0" p2 )
106. (command ".chspace" ss1 "")
107. (VL-CMDF "MVIEW" "L" "on" "all" "")AP
108. (if (< p2x p2y)
109.   (command "rotate" "all" "" p1 90 "move" "all" "" p3 p1)
110. )
111. )
117. (defun SDIR-1 (/ dwgname dwgname1)
118.   (setq num 0)
119.   (setq sslen (sslength ss))
120.   (while (< num sslen)
121.     (setq ent1 (vlax-ename->vla-object (ssname ss num)))
122.     (if        (= (vlax-get ent1 'Name) tkname)
123.       (progn
125.         (setq attobj (vlax-safearray->list
126.                        (vlax-variant-value (VLA-GETATTRIBUTES ent1))
127.                      )
128.         )
129.         (setq attlen (length attobj))
130.         (setq attnum 0)
131.         (while (< attnum attlen)
132.           (setq att (nth attnum attobj))
133.           (setq tagstr (vlax-get att 'TagString))
134.           (if (= tagstr attname)
135.             (progn
136.               (setq dwgname (STRCAT (vlax-get att 'TextString) ".dwg"))
137.               (setq attnum attlen)
138.             )
139.           )
140.           (setq attnum (1+ attnum))
141.         )
143.       )
144.     )
146.     (setq num (1+ num))
148.     (if        (= dwgname1 "")
149.       (progn
150.         (SETQ dwgname (list dwgname))
151.         (setq dwgname1 dwgname)
152.       )
153.       (setq dwgname1 (cons dwgname dwgname1))
154.     )
155.   )
157.   (SETQ X (cons dwgpath dwgname1))
158. )
160. (setq dwgpath nil
161.       F        nil
162.       FL nil
163.       F1 nil
164.       X        nil
165.       scrfile nil)
167.    ;init-1ialize
168. (defun init-1  ()
169.   (SDIR-1)
170.   (setq dwgpath (car X))
171.   (setq X (acad采用strlsort (cdr X)))
172.   (setq        n2 (rtos (length X) 2 0)
173.         n1 "1")
174.   (if (= n2 1)
175.     (setq dwgs "Drawing")
176.     (setq dwgs "Drawings"))
177.   )
178. (defun PROCESS-1 (/ SCRFILE DMSG)
179.   (setq SCRFILE (open PATH "W"))
180.   ;(setq SCRFILE (open "Automatic1.scr" "W"))
181.   (write-line
182.     (strcat
183.       "(dos采用getprogress
184.       "Automatic             "
185.       N2
186.       " "
187.       DWGS
188.       " selected total "
189.       "The Selected files is being progress, Please wait..." "
190.       N2
191.       ")"
192.      )
193.     SCRFILE
194.   )
195.   (write-line "(setvar "cmddia" 0)" SCRFILE)
196.   (foreach DWGFILE X
197.     ;(write-line "(load "Automatic.lsp")" SCRFILE)
198.     ;(write-line (strcat "(AP采用OPENP " DWGPATH DWGFILE " \ ")") SCRFILE)
199.     (if        (= CHKSDI 1)
200.       (write-line (strcat "open y "" DWGPATH DWGFILE """) SCRFILE)
201.       (write-line (strcat "open "" DWGPATH DWGFILE """) SCRFILE)
202.     )
203.     ;(write-line "DGNPURGE PU ZOOM E" SCRFILE)
204.     (write-line commands SCRFILE)
205.    
206.     (write-line "(dos采用getprogress -1)" SCRFILE)
207.     (if        (= N1 N2)
208.       (progn (write-line "(dos采用getprogress t)" SCRFILE)
209.              (write-line
210.                (strcat "(dos采用msgbox ""
211.                        N2
212.                        " Drawing(s) has been PROCESS-1." "PROCESS-1" 1 3 5)"
213.                )
214.                SCRFILE
215.              )
216.       )
217.     )
218.     (setq N1 (rtos (+ 1 (atoi N1)) 2 0))
219.     (write-line ".CLOSE n" SCRFILE)
220.   )
221.   (write-line "(setvar "cmddia" 1)" SCRFILE)
222.   (close SCRFILE)
223.   (command "script" PATH)
224. )
228. (princ)

复制代码