Topic: Need fresh eyes

[HasanCAD]

I I have to edit more than 500 file. each file containing a block or objects
I have to open each file then move all objects too layer 0 and change text's TEXTSTYLE
I coded this routine:
But have more than one issue
- While running the lisp I have to switch between VLIDE and AUTOCAD to complete the issue
- after run the lisp more than one time I can not edit the lisp
- in VLIDE cpmes the attached image

The code

Code - Auto/Visual Lisp: [Select]

1. ;  (MoveObjectsTo0)
2.  
3. (DEFUN MoveObjectsTo0 ( / )
4.   (vl-load-com)
5.   (setq StyName "AAWTextStyle")
6.   (setvar "insunits" 4)
7.   (if (and
8.         (setq a (ssget "_X"))
9.         (vl-cmdf "explode" a )
10.         (vl-cmdf "._zoom" "Extents" )
11.         (vl-cmdf "._-purge" "BLOCKS" "*" "n")
12.         (setq a (ssget "X"))
13.         (setq p1 (getpoint "Pick Point" ))
14.         (if (vl-cmdf "_.-insert" "L:/AAW-STND/CAD/Support/GENERAL/GENERAL.dwg" "0,0,0" "1" "1" "0"); inser
15.           (progn
16.             (vl-cmdf "_.erase" "last" "")
17.             (vl-cmdf "_.-purge" "blocks" "GENERAL" "n")))
18.         )
19.     (progn
20.       (IF (/= (GETVAR "DWGTITLED") 1)  
21.           (vl-cmdf "._qsave")
22.           )
23.       (vl-cmdf "_.move" a ""  p1 (list 0. 0. 0.) "")
24.       (repeat (setq i (sslength a))
25.         (setq b (vlax-ename->vla-object (ssname a (setq i (1- i)))))
26.         (vla-put-layer b "0")
27.         (vla-put-color b 256)
28.         (vla-put-Linetype b "ByLayer")
29.         )
30.       (cond
31.         ((and
32.            (setq ss (ssget "X" '((0 . "TEXT,MTEXT,ATTDEF"))))
33.            (repeat (sslength ss)
34.              (if
35.                (and
36.                  (setq e (ssname ss 0))
37.                  (setq eVL (vlax-ename->vla-object e))
38.                  )
39.              (vla-put-StyleName eVL StyName)
40.              (ssdel e ss)
41.            )
42.          )
43.         )
44.          )
45.       )
46.       (if               ; LEE MAC
47.         (and (ssget "_X")
48.          (progn
49.            (while
50.              (not
51.                (or (= "" (setq n (vl-filename-base (getvar 'dwgname))))
52.                    (and (snvalid n) (null (tblsearch "block" n))))
53.                )
54.              (princ "\nBlock name invalid or already exists.")
55.            )
56.            (if (= "" n) (setq n "*U"))
57.            (setq p (list 0. 0. 0.))))
58.      (progn
59.        (setq d (vla-get-activedocument (vlax-get-acad-object)))
60.        (vlax-for o (setq s (vla-get-activeselectionset d))
61.          (setq l (cons o l)))
62.        (vla-delete s)
63.        (vlax-invoke
64.          d
65.          'copyobjects
66.          l
67.          (setq b (vlax-invoke (vla-get-blocks d) 'add (trans p 1 0) n))
68.        )
69.        (vlax-invoke
70.          (vlax-get-property
71.            d
72.            (if (= 1 (getvar 'cvport))
73.              'paperspace
74.              'modelspace))
75.          'insertblock (trans p 1 0) (vla-get-name b) 1.0 1.0 1.0 0.0)
76.        (foreach o l (vla-delete o))))
77.  
78.       (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
79.       (vlax-for x blks (vlax-put-property x "Units" 4))
80.       (vla-put-explodable        (vla-item blks n) :vlax-false)
81.       (vla-put-BlockScaling      (vla-item blks n) acUniform)
82.       (vl-cmdf "._REGENALL")
83.       (vl-cmdf "._zoom" "Extents" )
84.       (vl-cmdf "._-purge" "ALL" "*" "n")
85.      
86.       (setq fp (getvar 'dwgprefix))
87.       (setq fn (vl-filename-base (getvar 'DWGName)))
88.      
89.       (setq blck (ssget "X" (list '(0 . "INSERT") (cons 2 fn))))
90.       ;(vl-cmdf "_.attsync" "_.select" "" (ssname blck 0))
91.       (setq blok (vlax-ename->vla-object (ssname blck 0)))
92.       (vlax-release-object blok)
93.       (vl-cmdf "._qsave")
94.       (vl-cmdf "mslide" (strcat fp fn ".sld") )
95.       (vl-file-delete (strcat fp fn ".bak"))
96.       (vl-cmdf "._close")
97.       )
98.     )
99.   )

[ribarm]

If I may ask, why do you need to edit lisp after execution in VLIDE? I've changed your code to be more readable, you haven't localized your variables... If your starting selection set contains more than 1 entity, you have to consider using QAFLAGS=1 temporarily to explode sel. set afterwards... I've put STYLE=Standard if your coded style name don't exist... No need for (cond), just single (if) can do the trick as good as should... I don't see why VLIDE wouldn't load lisp more times, I see no relevant issues regarding this problem... After all, you can put it in your temporary acaddoc.lsp so it will automatically load whenever you open new DWG, just don't know what do you meant by editing lisp meanwhile...

Code - Auto/Visual Lisp: [Select]

1.                                         ;  (MoveObjectsTo0)
2.  
3. (DEFUN MoveObjectsTo0 (/    a    b    blck blks blok d    e    evl
4.                        fn   fp   i    l    n    p    p1   qaf  s
5.                        ss   styname
6.                       )
7.  
8.   (vl-load-com)
9.  
10.   (if (tblsearch "STYLE" "AAWTextStyle")
11.     (setq styname "AAWTextStyle")
12.     (setq styname "Standard")
13.   )
14.   (setvar "INSUNITS" 4)
15.   (if (and
16.         (setq qaf (getvar "QAFLAGS"))
17.         (setvar "QAFLAGS" 1)
18.         (setq a (ssget "_X"))
19.         (vl-cmdf "_.EXPLODE" a)
20.         (setvar "QAFLAGS" qaf)
21.         (vl-cmdf "_.ZOOM" "_EXTENTS")
22.         (vl-cmdf "_.-PURGE" "_BLOCKS" "*" "_N")
23.         (setq a (ssget "_X"))
24.         (setq p1 (getpoint "\nPick or specify point : "))
25.         (if (vl-cmdf
26.               "_.-INSERT"
27.               "L:/AAW-STND/CAD/Support/GENERAL/GENERAL.dwg"
28.               "_non"                     "0,0,0"
29.               "1"                        "1"
30.               "0"
31.              )                          ; insert
32.           (progn
33.             (vl-cmdf "_.ERASE" "_LAST" "")
34.             (vl-cmdf "_.-PURGE" "_BLOCKS" "GENERAL" "_N")
35.           )
36.         )
37.       )
38.     (progn
39.       (if (/= (getvar "DWGTITLED") 1)
40.         (vl-cmdf "_.QSAVE")
41.       )
42.       (vl-cmdf "_.MOVE" a "" "_non" p1 "_non" (list 0.0 0.0 0.0) "")
43.       (repeat (setq i (sslength a))
44.         (setq b (vlax-ename->vla-object (ssname a (setq i (1- i)))))
45.         (vla-put-layer b "0")
46.         (vla-put-color b 256)
47.         (vla-put-Linetype b "ByLayer")
48.       )
49.       (if
50.         (and
51.           (setq ss (ssget "_X" '((0 . "TEXT,MTEXT,ATTDEF"))))
52.           (repeat (setq i (sslength ss))
53.             (if
54.               (and
55.                 (setq e (ssname ss (setq i (1- i))))
56.                 (setq evl (vlax-ename->vla-object e))
57.               )
58.                (vla-put-stylename evl styname)
59.             )
60.           )
61.         )
62.       )
63.  
64.       (if                               ; LEE MAC
65.         (and
66.           (ssget "_X")
67.           (progn
68.             (while
69.               (not
70.                 (or (= "" (setq n (vl-filename-base (getvar 'dwgname))))
71.                     (and (snvalid n) (null (tblsearch "BLOCK" n)))
72.                 )
73.               )
74.                (princ "\nBlock name invalid or already exists.")
75.             )
76.             (if (= "" n)
77.               (setq n "*U")
78.             )
79.             (setq p (list 0. 0. 0.))
80.           )
81.         )
82.          (progn
83.            (setq d (vla-get-activedocument (vlax-get-acad-object)))
84.            (vlax-for o (setq s (vla-get-activeselectionset d))
85.              (setq l (cons o l))
86.            )
87.            (vla-delete s)
88.            (vlax-invoke
89.              d
90.              'copyobjects
91.              l
92.              (setq
93.                b (vlax-invoke (vla-get-blocks d) 'add (trans p 1 0) n)
94.              )
95.            )
96.            (vlax-invoke
97.              (vlax-get-property
98.                d
99.                (if (= 1 (getvar 'cvport))
100.                  'paperspace
101.                  'modelspace
102.                )
103.              )
104.              'insertblock
105.              (trans p 1 0)
106.              (vla-get-name b)
107.              1.0
108.              1.0
109.              1.0
110.              0.0
111.            )
112.            (foreach o l (vla-delete o))
113.          )
114.       )
115.  
116.       (setq blks (vla-get-blocks
117.                    (vla-get-activedocument (vlax-get-acad-object))
118.                  )
119.       )
120.       (vlax-for x blks (vlax-put-property x "Units" 4))
121.       (vla-put-explodable (vla-item blks n) :vlax-false)
122.       (vla-put-blockscaling (vla-item blks n) acuniform)
123.       (vl-cmdf "_.REGENALL")
124.       (vl-cmdf "_.ZOOM" "_EXTENTS")
125.       (vl-cmdf "_.-PURGE" "_ALL" "*" "_N")
126.  
127.       (setq fp (getvar 'dwgprefix))
128.       (setq fn (vl-filename-base (getvar 'dwgname)))
129.       ;|
130.       (setq blck (ssget "X" (list '(0 . "INSERT") (cons 2 fn))))
131.                                         ;(vl-cmdf "_.attsync" "_.select" "" (ssname blck 0))
132.       (setq blok (vlax-ename->vla-object (ssname blck 0)))
133.       (vlax-release-object blok)
134.       |;
135.       (vl-cmdf "_.QSAVE")
136.       (vl-cmdf "_.MSLIDE" (strcat fp fn ".sld"))
137.       (vl-file-delete (strcat fp fn ".bak"))
138.       (vl-cmdf "_.CLOSE")
139.     )
140.   )
141.   (princ)
142. )
143.  

[HasanCAD]

Thanks for quick reply

If I may ask, why do you need to edit lisp after execution in VLIDE? ...

in some cases I need to change unites for some files.

...
If your starting selection set contains more than 1 entity, you have to consider using QAFLAGS=1 ...

Why is this variable added?

...
I've put STYLE=Standard if your coded style name don't exist
...

the inserted file GENERAL.dwg has this style.may be it is better to move after inserting the file.

...
just don't know what do you meant by editing lisp meanwhile
...

As told before some files unites should be Meter and rest should be in Millimeter So I opned more than one file after execution the lisp

Did you see attached pic
what is this symbol? I noticed that the number of symbols are increasing after each time run the lisp.

 Thanks for your valuable help.

[JohnK]

Off topic: I know I've see another (many) other threads with the same title. Can we please (please, please, please!) try to have better subject lines for these threads (better subject lines would help others find answers to their problems)?

[HasanCAD]

Final Issue

Code - Auto/Visual Lisp: [Select]

1. (DEFUN c:CreateNewBlocks (/    a    b    blck blks blok d    e    evl
2.                        fn   fp   i    l    n    p    p1   qaf  s
3.                        ss   styname
4.                       )
5.   (vl-load-com)
6.   (vl-cmdf "_.-PURGE" "_BLOCKS" "*" "_N")
7.   (if
8.     (setq blk (ssget "_X" '((0 . "INSERT"))))
9.     (progn
10.       (setq n (vl-filename-base (getvar 'dwgname)))
11.       (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
12.       (vla-put-explodable        (vla-item blks n) :vlax-true)
13.       (setq qaf (getvar "QAFLAGS"))
14.       (setvar "QAFLAGS" 1)
15.       (vl-cmdf "_.EXPLODE" blk "")
16.       (setvar "QAFLAGS" qaf)
17.       (zmPrg)
18.       )
19.     (zmPrg)
20.     )
21.   (if (and        
22.         (setq p1 (getpoint "\nPick or specify point : "))
23.         (if (vl-cmdf
24.               "_.-INSERT"
25.               "L:/AAW-STND/CAD/Support/GENERAL/GENERAL.dwg"
26.               "_non"                     "0,0,0"
27.               "1"                        "1"
28.               "0"
29.              )                          ; insert
30.           (progn
31.             (vl-cmdf "_.ERASE" "_LAST" "")
32.             (vl-cmdf "_.-PURGE" "_BLOCKS" "GENERAL" "_N")
33.           )
34.         )
35.         (setq styname "AAWTextStyle")
36.         (setq unts 4)           ; 4 millimeter / 6 meter
37.         (setvar "insunits" unts)
38.       )
39.     (progn
40.       (if (/= (getvar "DWGTITLED") 1) (vl-cmdf "_.QSAVE"))
41.       (vl-cmdf "_.MOVE" a "" "_non" p1 "_non" (list 0.0 0.0 0.0) "")
42.       (setq a (ssget "_X"))      
43.       (repeat
44.         (setq i (sslength a))
45.         (setq b (vlax-ename->vla-object (ssname a (setq i (1- i)))))
46.         (vla-put-layer b "0")
47.         (vla-put-color b 256)
48.         ;(vla-put-Linetype b "ByLayer")
49.       )
50.       (if (setq ss (ssget "_X" '((0 . "TEXT,MTEXT,ATTDEF"))))
51.         (repeat
52.           (setq i (sslength ss))
53.           (setq e (ssname ss (1- i)))
54.           (setq evl (vlax-ename->vla-object e))
55.           (vla-put-stylename evl styname)
56.           (setq i (1- i))
57.           )
58.         )
59.       (if                               ; LEE MAC
60.         (and
61.           (ssget "_X")
62.           (progn
63.             (while
64.               (not
65.                 (or (= "" (setq n (vl-filename-base (getvar 'dwgname))))
66.                     (and (snvalid n) (null (tblsearch "BLOCK" n)))
67.                 )
68.               )
69.                (princ "\nBlock name invalid or already exists.")
70.             )
71.             (if (= "" n)
72.               (setq n "*U")
73.             )
74.             (setq p (list 0. 0. 0.))
75.           )
76.         )
77.          (progn
78.            (setq d (vla-get-activedocument (vlax-get-acad-object)))
79.            (vlax-for o (setq s (vla-get-activeselectionset d))
80.              (setq l (cons o l))
81.            )
82.            (vla-delete s)
83.            (vlax-invoke
84.              d
85.              'copyobjects
86.              l
87.              (setq
88.                b (vlax-invoke (vla-get-blocks d) 'add (trans p 1 0) n)
89.              )
90.            )
91.            (vlax-invoke
92.              (vlax-get-property
93.                d
94.                (if (= 1 (getvar 'cvport))
95.                  'paperspace
96.                  'modelspace
97.                )
98.              )
99.              'insertblock
100.              (trans p 1 0)
101.              (vla-get-name b)
102.              1.0
103.              1.0
104.              1.0
105.              0.0
106.            )
107.            (foreach o l (vla-delete o))
108.          )
109.       )
110.  
111.       (setq blks (vla-get-blocks
112.                    (vla-get-activedocument (vlax-get-acad-object))
113.                  )
114.       )
115.       (vlax-for x blks (vlax-put-property x "Units" 4))
116.       (vla-put-explodable (vla-item blks n) :vlax-false)
117.       (vla-put-blockscaling (vla-item blks n) acuniform)
118.       (zmPrg)
119.       (setq fp (getvar 'dwgprefix))
120.       (setq fn (vl-filename-base (getvar 'dwgname)))
121.       (vl-cmdf "_.QSAVE")
122.       (vl-cmdf "_.MSLIDE" (strcat fp fn ".sld"))
123.       (vl-file-delete (strcat fp fn ".bak"))
124.       (vl-cmdf "_.CLOSE")
125.     )
126.   )
127.   (princ)
128. )
129. (defun zmPrg ( / )
130.   (vl-cmdf "_.REGENALL")  
131.   (vl-cmdf "_.ZOOM" "_EXTENTS")
132.   (vl-cmdf "_.-PURGE" "_ALL" "*" "_N")
133.   )