批量分图

jxmjg

1. ;;;   Revised on 20200328
   
2. 
   
3. (defun c:PLFT (/ dwgpath tkname         attname ss         num         sslen
   
4.                  ent1         p1         p2         attobj         attlen         attnum
   
5.                  att         tagstr         ssf         osm PATH
   
6.                 )
   
7. 
   
8. 
   
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 "请选取批量输出的范围:")
    
30. 
    
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))
    
42. 
    
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.                         )
    
57. 
    
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"))
    
66. 
    
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)
    
84. 
    
85. )
    
86. 
    
87. 
    
88. ;更改空间
    
89. (defun c:ggkj (/ ss1 ent1 tb tbs p1 p2 p2a p3 p2x p2y)
    
90. 
    
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>"))))
    
93. 
    
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. )
     
112. 
     
113. 
     
114. 
     
115. 
     
116. 
     
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
     
124. 
     
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.         )
     
142. 
     
143.       )
     
144.     )
     
145. 
     
146.     (setq num (1+ num))
     
147. 
     
148.     (if        (= dwgname1 "")
     
149.       (progn
     
150.         (SETQ dwgname (list dwgname))
     
151.         (setq dwgname1 dwgname)
     
152.       )
     
153.       (setq dwgname1 (cons dwgname dwgname1))
     
154.     )
     
155.   )
     
156. 
     
157.   (SETQ X (cons dwgpath dwgname1))
     
158. )
     
159. 
     
160. (setq dwgpath nil
     
161.       F        nil
     
162.       FL nil
     
163.       F1 nil
     
164.       X        nil
     
165.       scrfile nil)
     
166. 
     
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. )
     
225. 
     
226. 
     
227. 
     
228. (princ)
     
229. 
     

复制代码