Topic: Optimizing horribly inefficient code

[S.Langhammer]

Hey,
the title already tells you, I'm aware, how badly inefficient the first variant is so, lough if you feel like it.

I've been away from lisp for a little while now and didn't work on my script, because I thought it was working correctly now.
WRONG.

When I try to read the entity information from a file with it, it happens that some entities within blocks are exported as if they were displaced by the insertion point of an insert (and I can't even tell which, if there are multiple inserts of the same block).
Example: a Block contains this line P1(0,1,0) P2(0,2,0)
              the block-reference would be inserted here: P3(2,5,3)
              then the exported line looks like this: P1e(2,6,3) P2e(2,7,3)

Here's the inefficient version, which seems to do the job:

Code - Auto/Visual Lisp: [Select]

1. (defun simplify ( chkBlk / objType a b ret test)
2.         (setq objType "")
3.         (foreach a (Blk_ENameLstNstd chkBlk)
4.                 (foreach b (entget a)
5.                         (if (= (car b) 100)
6.                                 (setq objType (cdr b))
7.                         )
8.                 )
9.                 (if (= (strcase objType) "ACDBSPLINE")(progn
10.                         (vl-catch-all-apply 'convertSpline (list a))
11.                 ))
12.                 (vl-catch-all-apply 'ExplodeObject (list a))
13.         )
14. )
15.  
16.  
17. (defun ExplodeObject    (object
18.                                                                 /       N_ExplodeCommandModelSpace
19.                                                                         N_ExplodeCommandOther
20.                                                                         N_ExplodeMethod
21.                                                                         correctPosition
22.                                                                         modelSpaceObject ownerObject
23.                                                 )
24.  
25.         (defun correctPosition (object / lastEname newEnameList newObjectList tempObject)
26.                 (setq lastEname (entlast))
27.                 (while (entnext lastEname)
28.                         (setq lastEname (entnext lastEname))
29.                 )
30.  
31.                 (setq tempObject
32.                         (car
33.                                 (vlax-invoke
34.                                         activeDocument
35.                                         'copyobjects
36.                                         (list object)
37.                                         modelSpaceObject
38.                                 )
39.                         )
40.                 )
41.                 (vla-delete object)
42.                 (while (setq lastEname (entnext lastEname))
43.                         (setq newEnameList (cons lastEname newEnameList))
44.                 )
45.                 (if newEnameList
46.                         (setq newObjectList
47.                                 (vlax-invoke
48.                                         activeDocument
49.                                         'copyobjects
50.                                         (mapcar 'vlax-ename->vla-object newEnameList)
51.                                         ownerObject
52.                                 )
53.                         )
54.                 )
55.                 (mapcar 'entdel newEnameList)
56.         )                                      
57.                                                
58.                                                
59.         (defun N_ExplodeCommandModelSpace (object / lastEname newEnameList)
60.                 ; Store the ename of the last object in modelspace:
61.                 (setq lastEname (entlast))
62.                 ; Required for 'SEQEND situations':
63.                 (while (entnext lastEname)
64.                         (setq lastEname (entnext lastEname))
65.                 )
66.                 ; Use the explode command:
67.                 (command "_.explode" (vlax-vla-object->ename object))
68.                 ; Get the enames of all new objects in modelspace:
69.                 (while (setq lastEname (entnext lastEname))
70.                         (setq newEnameList (cons lastEname newEnameList))
71.                 )
72.                 (mapcar 'vlax-ename->vla-object newEnameList)
73.         )
74.  
75.                 ;; The function uses the following variables from the main function:
76.                 ;;   docObject
77.                 ;;   modelSpaceObject
78.                 ;;   ownerObject
79.         (defun N_ExplodeCommandOther (object / lastEname newEnameList newObjectList tempObject)
80.                 ; Store the ename of the last object in modelspace:
81.                 (setq lastEname (entlast))
82.                 ; Required for 'SEQEND situations':
83.                 (while (entnext lastEname)
84.                         (setq lastEname (entnext lastEname))
85.                 )
86.                 ; Make a temporary copy of the object from the block definition in modelspace:
87.                 (setq tempObject
88.                         (car
89.                                 (vlax-invoke
90.                                         activeDocument
91.                                         'copyobjects
92.                                         (list object)
93.                                         modelSpaceObject
94.                                 )
95.                         )
96.                 )
97.                 ; Delete the object from the block definition:
98.                 (vla-delete object)
99.                 ; Use the explode command:
100.                 (command "_.explode" (vlax-vla-object->ename tempObject))
101.                 ; Get the enames of all new objects in modelspace:
102.                 (while (setq lastEname (entnext lastEname))
103.                         (setq newEnameList (cons lastEname newEnameList))
104.                 )
105.                 ; Copy the new objects to the block definition:
106.                 (if newEnameList
107.                         (setq newObjectList
108.                                 (vlax-invoke
109.                                         activeDocument
110.                                         'copyobjects
111.                                         (mapcar 'vlax-ename->vla-object newEnameList)
112.                                         ownerObject
113.                                 )
114.                         )
115.                 )
116.                 ; Delete the new entities from modelspace:
117.                 (mapcar 'entdel newEnameList)
118.                 ; Return the new objects in the block definition:
119.                 newObjectList
120.         )
121.  
122.         (defun N_ExplodeMethod (object / newObjectList)
123.                 (setq newObjectList (vlax-invoke object 'explode))
124.                 (vla-delete object)
125.                 ; Return the new objects in the block definition:
126.                 newObjectList
127.         )
128.         (setq object (vlax-ename->vla-object object))  
129.         (if (vlax-method-applicable-p object 'explode)
130.                 (N_ExplodeMethod object)
131.                 (progn
132.                         ; Make sure that modelspace is current:
133.                         (setvar 'tilemode 1)
134.                         (setq modelSpaceObject  (vla-get-modelspace activeDocument)
135.                                   ownerObject           (vla-objectidtoobject activeDocument (vla-get-ownerid object))
136.                         )
137.                         (if (= ownerObject modelSpaceObject)
138.                                 (progn
139.                                         (if     (not(wcmatch (strcase objType) safeObjects))
140.                                                 (N_ExplodeCommandModelSpace object)
141.                                         )
142.                                 )
143.                                 (progn
144.                                         (if     (not(wcmatch (strcase objType) safeObjects))
145.                                                 (N_ExplodeCommandOther      object)
146.                                                 (correctPosition                        object)
147.                                         )
148.                                 )
149.                                
150.                         )
151.                 )
152.         )
153. )
154. ;;;
155.  
156. (setq activeDocument (vla-get-activedocument(vlax-get-acad-object))
157.                   safeObjects "ACDBXLINE,ACDBVIEWPORT,ACDBVERTEX,ACDBTRACE,ACDBFCF,ACDBTEXT,ACDBSHAPE,ACDBRAY,ACDBPOINT,ACDBPOLYFACEMESH,ACDBOLE2FRAME,ACDBOLEFRAME,ACDBLINE,ACDBBLOCKREFERENCE,ACDBRASTERIMAGE,ACDBELLIPSE,ACDBCIRCLE,ACDBARC,ACDBFACE,ACDBATTRIBUTE,ACDBSPLINE,ACDBHATCH"
158.                  
159.         )
160.  
161. (setq test 0)
162.         (while  (< test 5)
163.                 (setq chkCond nil)
164.                 (while (setq LstBlk (tblnext "BLOCK" (not LstBlk)))
165.                         (if     (and
166.                                         (/=(substr(setq blkN(cdr(assoc 2 LstBlk)))1 1)"*")
167.                                         (= T(contentCheck(Blk_ENameLstNstd blkN)))
168.                                 )
169.                                 (simplify blkN)
170.                         )
171.  
172.                 )
173.                 (setq test (1+ test))
174.         )
175.  

No need to tell me how badly written and horribly inefficient it is and what it behaves like in large files. But matter of fact, I have noone around to check it and help me directly.

"correctPosition" served it's purpose well. But you can imagine, how long this can take.
It was just a first quick and dirty attempt to generally find a solution for my issue so after I saw it generally worked I tryed to build it this way (explode object works about the same way, just without correctPosition):

Code - Auto/Visual Lisp: [Select]

1.  
2. (defun simplify ( chkBlk / objType a b ret test)        ;;; löst komplexe entitäten auf, Blockname als eingangsvariable
3.         (setq objType ""
4.                   ret nil)
5.         (foreach a (Blk_ENameLstNstd chkBlk)
6.                 (foreach b (entget a)
7.                         (if (= (car b) 100)
8.                                 (setq objType (cdr b))
9.                         )
10.                 )
11.                 (if (= (strcase objType) "ACDBSPLINE")(progn
12.                         (vl-catch-all-apply 'convertSpline (list a))
13.                         (setq ret T)
14.                 ))
15.                 (if     (not(wcmatch (strcase objType) safeObjects))(progn
16.                         (vl-catch-all-apply 'ExplodeObject (list a))
17.                         (setq ret T)
18.                 ))
19.         )
20.         ret ;;; gibt T zurück, wenn etwas vereinfacht werden konnte, andernfalls nil
21. )
22. ;;;
23. (defun correctPositionInBlock (object / lastEname newEnameList newObjectList tempObject)
24.         ;;; ename zu objekt
25.         (show "entität" (entget object))
26.         (setq object (vlax-ename->vla-object object))  
27.         (show "objekt" object)
28.         ; Make sure that modelspace is current:
29.         (setvar 'tilemode 1)
30.         (setq modelSpaceObject  (vla-get-modelspace activeDocument)
31.                   ownerObject           (vla-objectidtoobject activeDocument (vla-get-ownerid object))
32.         )
33.  
34.         ;;; letzte entität im modelspace speichern
35.         (setq lastEname (entlast))
36.         (while (entnext lastEname)
37.                 (setq lastEname (entnext lastEname))
38.         )
39.        
40.         ;;; temporäre kopie des objekts anlegen
41.         (setq tempObject
42.                 (car
43.                         (vlax-invoke
44.                                 activeDocument
45.                                 'copyobjects
46.                                 (list object)
47.                                 modelSpaceObject
48.                         )
49.                 )
50.         )
51.         ;;; aus dem original aus dem block löschen
52.         (vla-delete object)
53.         ;;; liste der neuen Objekte anlegen
54.         (while (setq lastEname (entnext lastEname))
55.                 (show "neue entity" (entget lastEname))
56.                 (setq newEnameList (cons lastEname newEnameList))
57.         )
58.         ;;; die neuen objekte zurück in den block kopieren
59.         (if newEnameList
60.                 (setq newObjectList
61.                         (vlax-invoke
62.                                 activeDocument
63.                                 'copyobjects
64.                                 (mapcar 'vlax-ename->vla-object newEnameList)
65.                                 ownerObject
66.                         )
67.                 )
68.         )
69.         ;;; die temporären objekte löschen
70.         (mapcar 'entdel newEnameList)
71.  
72. )
73. ;;;
74.  
75.  
76.         (setq activeDocument (vla-get-activedocument(vlax-get-acad-object))
77.                   safeObjects "ACDBXLINE,ACDBVIEWPORT,ACDBVERTEX,ACDBTRACE,ACDBFCF,ACDBTEXT,ACDBSHAPE,ACDBRAY,ACDBPOINT,ACDBPOLYFACEMESH,ACDBOLE2FRAME,ACDBOLEFRAME,ACDBLINE,ACDBBLOCKREFERENCE,ACDBRASTERIMAGE,ACDBELLIPSE,ACDBCIRCLE,ACDBARC,ACDBFACE,ACDBATTRIBUTE,ACDBSPLINE,ACDBHATCH"
78.         )
79.        
80.        
81.         (setq chkCond T
82.                   test 0
83.         )
84.         (while  (and
85.                                 (= chkCond T)
86.                                 (< test 5)      ;;; notfall abbruch bedingung, in der regel sollte keine komplexe entität mehr als 4 ebenen haben
87.                         )
88.                 (setq chkCond nil)
89.                 (while (setq LstBlk (tblnext "BLOCK" (not LstBlk)))
90.                         (setq chkCond   (if     (and
91.                                                                         (/=(substr(setq blkN(cdr(assoc 2 LstBlk)))1 1)"*")
92.                                                                         (= T(contentCheck(Blk_ENameLstNstd blkN)))
93.                                                                 )
94.                                                                         (simplify blkN)
95.                                                         )
96.                                   chkCond (if chkCond chkCond nil)
97.                         )
98.                 )
99.                 (setq test (1+ test))
100.         )
101.        
102.         (while (setq LstBlk2 (tblnext "BLOCK" (not LstBlk2)))
103.                 (if     (/=(substr(setq blkN(cdr(assoc 2 LstBlk3)))1 1)"*")
104.                         (foreach a (Blk_ENameLstNstd blkN)
105.                                 (correctPositionInBlock a)
106.                         )
107.                 )
108.         )
109.        
110.  

but now correcting the position doesn't work anymore. Does anyone have an idea? I'm thankfull for everything i get! (also: no need to tell me that the second version stil need refactoring. I'm aware it's still not really efficient)

[roy_043]

Steven, two questions:
1.
Where in your first code block do you think the coordinates are corrected? I don't see it.
2.
As you have mentioned in one of your previous posts: exploding all block is not an option. If the line in block "A" stays inside that block definition any 'correction' of coordinates does not make sense.
What should happen in this situation:
Block "A" contains a line from (0 1 0) to (0 2 0).
Block reference 1 of "A"
  Insertion point = (2 5 3)
  Scaling = (1 1 1)
Block reference 2 of "A"
  Insertion point = (11 13 39)
  Scaling = (3 -3 3)
The exported line should look like...?

[S.Langhammer]

First of all: I'm very sorry for the late respond. I've been to vocational college the last weeks and I have no access to the company files form my private laptop.

I should admit I'm looking at my code right now after quite a long time and I'm a bit confused myself right now.

Also I see that I accedently posted a false verison of my code. I must have made this post between two tasks. :/ Sorry about that!

The lintes 143 til 148 shouldne't be

Code - Auto/Visual Lisp: [Select]

1. (progn
2.         (if     (not(wcmatch (strcase objType) safeObjects))
3.                 (N_ExplodeCommandOther      object)
4.                 (correctPosition                        object)
5.         )
6. )
7.  

but actually

Code - Auto/Visual Lisp: [Select]

1. (progn
2.         (if     (wcmatch (strcase objType) safeObjects)
3.                 (correctPosition        object)
4.         )
5. )
6.  

I really must have been in a rush when I posted that.

To your second question: I understand what you mean and it confuses me as well.

From the pure logical part you should be absolutly correct: there shoulden't be any displace at all. That's what I thought as well.

formating of a block:
BLOCK,"name of the block"
any entities the block might contain
End of "name of the block"

formating of a block reference: INSERT,layer,"name of the block it refairs to",Xinsertion point,Yinsertion point,Zinsertion point,Xscaling factor,Yscaling factor,Zscaling factor,rotation angle,Xextrusion direction,Yextrusion direction,Zextrusion direction(linefeed)

formating of a line: LINE,layer,Xstart point,Ystart point,Zstart point,Xend point,Yend point,Zend point,length

The export should look about like this(assuming everything is placed on layer 0):

0 //theres a list of all layers in the first line of every exported file
BLOCK,A
LINE,0,0.0000,1.0000,0.0000,0.0000,2.0000,0.0000,1.0000
End of A
INSERT,0,A,2.0000,5.0000,3.0000,1.0000,1.0000,1.0000,rotation angle,Xextrusion direction, Yextrusion direction,Zextrusion direction
INSERT,0,A,11.0000,13.0000,39.0000,3.0000,-3.0000,3.0000,rotation angle,Xextrusion direction, Yextrusion direction,Zextrusion direction

Would it be of any use if I post a kind of program flow chart how the functions of the script are supposed to work? Maybe that way I could clarify my train of thoughts and you could see errors in my algorhythm I don't see because I constantly stare at them.
You propably know how errors love to hide in the plain sight of beginners.

[S.Langhammer]

I'm not entirely sure but I might have found the source of the displacement.
Early in the main script I create a UCS identically to the WCS, because I don't know how to set the WCS the active coordinate system.

Code - Auto/Visual Lisp: [Select]

1.         (vla-put-activeucs activeDocument
2.                 (vla-add
3.                         (vla-get-usercoordinatesystems activeDocument)
4.                         (vlax-3d-point '(0 0 0)) ;origin
5.                         (vlax-3d-point '(1 0 0)) ;x-axis
6.                         (vlax-3d-point '(0 1 0)) ;y-axis
7.                         "World"
8.                 )
9.         )
10.  

Then the functions to get the information from the entities look like this:

Code - Auto/Visual Lisp: [Select]

1. (defun getInsData( ent / entName entRot entNorm LstBlk entPt  test)     ;;;Inserts
2.         (setq entNorm   (cdr(assoc 210 ent))                    ;;; Extrusion vector
3.                   entPt         (trans(cdr(assoc 10 ent))1 0)   ;;; Insertion point
4.         )
5.         ;;; in case of an anonymously or automaticly generated insert, there's a block generated
6.         (if (=(substr(setq entName(cdr(assoc 2 ent)))1 1)"*")(progn
7.                 ;;; breaking down non readable entities in this block
8.                 (setq test 0)
9.                 (while  (< test 5)      ;;; emergency stop, I haven't come across entities with more than 4 levels of complexity
10.                         (if(= T(contentCheck(Blk_ENameLstNstd entName)))
11.                                 (simplify blkN)
12.                         )
13.                         (setq test (1+ test))
14.                 )
15.                 (fileWrite (strcat "BLOCK," entName))
16.                 ;;; 0 . Entitätentyp
17.                 ;;; 1 . Blockname
18.                 (getinfo (Blk_ENameLstNstd entName))
19.                 (fileWrite (strcat "End of " entName))
20.         ))
21.         (fileWrite(strcat "INSERT,"(cdr(assoc 8 ent))"," entName ","(rtos(car entPt)2 4)","(rtos(cadr entPt)2 4)","(rtos(caddr entPt)2 4)","(rtos(cdr(assoc 41 ent))2 4)","(rtos(cdr(assoc 42 ent))2 4)","(rtos(cdr(assoc 43 ent)) 2 4)","(if(setq entRot(cdr(assoc 50 ent)))(vl-string-right-trim "r"(angtos entRot 3 4))"0")","(rtos(car entNorm)2 4)","(rtos(cadr entNorm)2 4)","(rtos(caddr entNorm)2 4)))
22.         ;;; 0 . Entity type
23.         ;;; 1 . Layer
24.         ;;; 2 . Blockname
25.         ;;; 3;4;5 . Insertion point X,Y,Z
26.         ;;; 6;7;8 scaling X,Y,Z
27.         ;;; 9 . Rotation
28.         ;;; 10;11;12 . Extrusion vector
29.         (princ)
30. )       ;;; end getInsData
31.  
32. ;;; and
33.  
34. (defun getLinData( ent / entAPt entEPt) ;;; Lines
35.         (setq entAPt    (cdr(assoc 10 ent))     ;;; Start point
36.                   entEPt        (cdr(assoc 11 ent))     ;;; End point
37.         )
38.         (fileWrite(strcat "LINE,"(cdr(assoc 8 ent))","(rtos(car entAPt)2 4)","(rtos(cadr entAPt)2 4)","(rtos(caddr entAPt)2 4)","(rtos(car entEPt)2 4)","(rtos(cadr entEPt)2 4)","(rtos(caddr entEPt)2 4)","(rtos(distance entAPt entEPt)2 4)))                                                                                                                                                                                                                                
39.         ;;; 0 . Entitity type
40.         ;;; 1 . Layername
41.         ;;; 2;3;4 . Start point
42.         ;;; 5;6;7 . End point
43.         ;;; 8 .  Length
44.         (princ)
45. )       ;;; end getLinData
46.  

Does this somehow collide in any way?