Computer lagg from Code

[Trudy]

Heloo everyone i want to ask for help.

I write one code and try different stuff for fast working but when i start the code my computer lagg and when code is finsh i just see the result.

Everything is good but i want to "(princ (strcat "someting " (rtos (+ n 1) 2 0))) to see how i go.

 

This when i thing for the problem is because i have two lists:

First with around 700 items (get from ssget "X").

Second with around 900 items(get from ssget "X").

 

And foreach of second list i check the first list. This is 900*700.

 

Function i try to get the entity:

-Repeat (ssname ssget1 (i-1)) and other math.

 

Now i try to convert selection sets into vl-selections and use (vlax-for x ssget1 (progn  .... and math ....))

 

 

Vlax-for x --- is faster but when i try to princ something lagg and i see only the result. Without princ lagg again.

 

If someone can give me some advice how to make it to work without lagg.

I think to try now (ssnamex and mapcar , lamba (x) )

 

Thank you

 

 

 

[mhupp]

What is the code doing? why are you comparing two lists?

 

What I did for a lisp that had over 27k items in a list is add a counter to the foreach loop to stop every 1000 items and ask to continue.

 

[Trudy]

in first loop: for each item in selection set (all items are closed polylines)

1.export pline coord 

2.From function take coord on centroid from the poly

3.Take area from poly

and now second loop in first: (here all items are block with 1 attributes)

1.Get insert point from block

2.From function check if point (from 1) is inside in poly from first loop.

3.Setq some to check if point (from1) is on the poly (vlax-curve-getClosestPointTo (pline from first loop) (pt from 1) if is close to 0.01m with Pt (from 1) (setq some (cons ... some)) if not do other.

4.If check function is T do (cons)

Close second loop.

Back in first loop

4.If (if cons (from 4 at second loop) is not 0) then (cons list with area coord cent and other)

Close loop 1

 

Mapcar on list from this loops to insert block with data.

Its around 700*800 = 560 000 stuff.

[mhupp]

Sounds like your using something like this.

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-insert-block-to-inside-of-selected-closed-polygons/td-p/9007195

 

That amount of information is going to take most computers some time to work thought. Again breaking it up with a counter while it won't be faster the lisp wont freeze up your computer. or limit your selection to something your computer can handle.

[ronjonp]

You should post your code .. many times the algorithm can be improved upon.

[BIGAL]

I changed from "command text" to "entmake text" it was like 3 minutes v's 10 seconds.

 

Agree with Ronjonp pot code.

 

There is also progress bar lisp handy in this situation can see it moving. 

 

 

[dan20047]

Code that causes a visual change to the screen or console will always be slow. You can append strings to a list as the code runs, then princ the list when it is done to speed things up. If you want feedback while running the code, you could could track variable TDUSRTIMER then princ the buffer every 1/2 second or so, should greatly reduce the lag.

[BIGAL]

With no code, for this

1.Get insert point from block

2.From function check if point (from 1) is inside in poly from first loop.

 

Using ssget "WP" can find blocks inside If using some form of algorithm may be slower.

[Trudy]

Okayy thank you all.

I think all is from my computer, when i try one code with 3 different ways. Same result.

And when i try in lower version (autocad) not on civil work how i want.

I make it with:

1.Repeat - slowest for me 

2.Vlax-for - this is the fastest

3.Mapcar '(lambda (x)) - 4 sec difference from 2

 

I dont want to uppload the code because its a big part of all code.

But i will upload the main part.

(vlax-for x sscordd
	(progn
			(princ (strcat "\rFigura " (rtos i 2 0) " from " (rtos lenSS 2 0)))
			(setq tcord (LM:group-n (vlax-get x 'coordinates) 2))
			(setq cenn (R:cent (vlax-vla-object->ename x)))
			(setq area (vlax-get x 'area))
					(vlax-for y sscordd2
						(progn
							(setq pt (vlax-get y 'InsertionPoint))	
							(setq INN (pt_inorout tcord pt))
							(setq BGS (if (equal (vlax-curve-getClosestPointTo x pt) pt 0.01) (setq BGS (abs (atof (vlax-get (car (vlax-invoke y 'GetAttributes)) 'TextString)))) (if INN (setq BGS (abs (atof (vlax-get (car (vlax-invoke y 'GetAttributes)) 'TextString)))))))
							(if BGS (setq con (cons BGS con)))
							(setq INN nil)
							(setq BGS nil)
						)
					)
			(if (= (length con) 0) (setq con nil) (setq con2 (cons (list cenn area con) con2)))
			(setq con nil)	
			(setq i (+ i 1))
	)
)
(setq lenn (length con2))
(mapcar '(lambda ( x ) (progn (setq nom (+ 1 nom)) (princ (strcat "\rImport block " (rtos nom 2 0) " from " (rtos lenn 2 0)))(insD (nth 0 x) "OBEMM" 0.25 (list nom (rtos (/ (apply '+ (nth 2 x)) (length (nth 2 x))) 2 1) (rtos (nth 1 x) 2 1) (rtos (* (nth 1 x) (* (/ (apply '+ (nth 2 x)) (length (nth 2 x))) 0.01)) 2 1) nom "%%o          ")))) con2)
(princ)


;.....................................................................
mapcar '(lambda (x)
			(if (= (car x) 0)
				(progn
						(princ (strcat "\rFigura " i " from " lenSS))
						(setq vnam (vlax-ename->vla-object (cadr x)))
						(setq tcord (LM:group-n (vlax-get vnam 'coordinates) 2))
						(setq cenn (R:cent (cadr x)))
						(setq area (vlax-get vnam 'area))
							(mapcar '(lambda (y)
										(if (= (car y) 0)
											(progn
												(setq vnam2 (vlax-ename->vla-object (cadr y)))
												(setq pt (vlax-get vnam2 'InsertionPoint))
												(setq INN (pt_inorout tcord pt))
												(setq BGS (if (equal (vlax-curve-getClosestPointTo vnam pt) pt 0.01) (setq BGS (abs (atof (vlax-get (car (vlax-invoke vnam2 'GetAttributes)) 'TextString)))) (if INN (setq BGS (abs (atof (vlax-get (car (vlax-invoke vnam2 'GetAttributes)) 'TextString)))))))
												(if BGS (setq con (cons BGS con)))
												(setq INN nil)
												(setq BGS nil)
											)
										)
									)
									(ssnamex sscord2)
							)
						(if (= (length con) 0) (setq con nil) (setq con2 (cons (list cenn area con) con2)))
						(setq con nil)
						(setq i (+ i 1))
				)
			)
		) (ssnamex sscord))
(setq lenn (length con2))
(mapcar '(lambda ( x ) (progn (setq nom (+ 1 nom)) (princ (strcat "\rImport block " nom " from " lenn))(insD (nth 0 x) "OBEMM" 0.25 (list nom (rtos (/ (apply '+ (nth 2 x)) (length (nth 2 x))) 2 1) (rtos (nth 1 x) 2 1) (rtos (* (nth 1 x) (* (/ (apply '+ (nth 2 x)) (length (nth 2 x))) 0.01)) 2 1) nom "%%o          ")))) con2)
(princ)
;......................................................................
(repeat (setq i (sslength sscord))
	(princ (strcat "\rFigura " (rtos i 2 0) " from " (rtos lenSS 2 0)))
	(setq val nil)
	    (setq Vname (vlax-ename->vla-object (ssname sscord (setq i (1- i)))))		
		(setq tcord (LM:group-n (vlax-get Vname 'coordinates) 2))
			(setq cenn (R:cent (ssname sscord i)))
			(setq area (vlax-get Vname 'area))
			(repeat (setq ii (sslength sscord2))
			;(princ (strcat "\rWork..."))
				(setq Bvname (vlax-ename->vla-object (ssname sscord2 (setq ii (1- ii)))))
					(setq pt (vlax-get Bvname 'InsertionPoint))	
					(setq INN (pt_inorout tcord pt))
					;(princ BGS)
					(setq BGS (if (equal (vlax-curve-getClosestPointTo Vname pt) pt 0.01) (setq BGS (abs (atof (vlax-get (car (vlax-invoke Bvname 'GetAttributes)) 'TextString)))) (if INN (setq BGS (abs (atof (vlax-get (car (vlax-invoke Bvname 'GetAttributes)) 'TextString)))))))
					(if BGS (setq con (cons BGS con)))
					(setq INN nil)
					(setq BGS nil)
			)
		(if (= (length con) 0) (setq con nil) (setq con2 (cons (list cenn area con) con2)))
			(setq con nil)
	)
	;(foreach y con2 (princ (apply '+ (nth 1 y))))
(mapcar '(lambda ( x ) (progn (setq nom (+ 1 nom)) (princ (strcat "\rImport block " (rtos nom 2 0) " from " (rtos lenn 2 0)))(insD (nth 0 x) "OBEMM" 0.25 (list nom (rtos (/ (apply '+ (nth 2 x)) (length (nth 2 x))) 2 1) (rtos (nth 1 x) 2 1) (rtos (* (nth 1 x) (* (/ (apply '+ (nth 2 x)) (length (nth 2 x))) 0.01)) 2 1) nom "%%o          ")))) con2)
(princ)
 

 

Edited April 20, 2021 by Trudy

[rlx]

Also a drawing or picture (before / after / end result) would make things more clear probably... purpose of your routine is to make a list of which block goes to bed with which poly?

Point is , can there be more than one block in 'bed' with the same poly? If not , you could first convert each selection to a list ( (poly-1) ... (poly-700)) and /or ( (block-1) ... (block-900)) and while going through your lists , remove items that are processed from list so each new cycle your list become smaller and smaller and this would mean a much faster routine in the end.

 

 

 

[BIGAL]

Like rlx as I already mention change the get closestpointto to a more direct ssget, also a dwg would explain a lot more.

 

I use (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))) for co-ordinates maybe its faster than get-coordinates and  run the convert to list ?

[Trudy]

I found faster solution.

Foreach pline box i create selection set for blocks.

And now is 700*5 not 700*900.

 

Thank you all

[rlx]

as suggested by BigAL 'Using ssget "WP" can find blocks inside If using some form of algorithm may be slower.'

[Trudy]

I try at first with WP but this dont work how i want and i try something other (this where i post) now i try same thing but ssget Wp and then filter. 

With my code i check in all block if they are in polygon. (now just in 5-6)

[rlx]

It's the end result that counts so glad you've got it working! Happy coding

[BIGAL]

It may need CP instead of WP its a bit like the window select left to right v's right to left. the cp will find a object that crosses the object in my test a pline.

 

 (sslength (ssget "CP" co-ord '((0 . "CIRCLE"))))
17
: (sslength (ssget "wP" co-ord '((0 . "CIRCLE"))))
17

 

Edited April 22, 2021 by BIGAL