BlockName to variable

[pBe]

This routine will a assign a value to a variable with the same name as the block it counts I created this as a subroutine for a program that updates the Fields on a table. This would be my first attempt with the mapcar/Lambda function mixed with Vlisp codes. appreciate any comments and suggestions

Is it just me or its really less troublesome to filter selecton sets with good 'ol Lisp.... (vlax-safearray..... and the like is just too busy

 

(defun BlockName_to_variable ()
 (setq ol_blks (ssget "x" '((0 . "INSERT") (8 . "LayerName1,LayerName2")))
bn_lst (mapcar 'vlax-ename->vla-object
  (mapcar 'cadr (ssnamex ol_blks))
 )
 )
 (mapcar '(lambda (n)
     (if (not (member (vla-get-effectivename n) fnl_lst))
       (setq fnl_lst (cons (vla-get-effectivename n) fnl_lst))
     )
     (princ)
   )
  bn_lst
 )
 (mapcar '(lambda (x)
     (setq cnt 0)
     (foreach itm (mapcar 'vla-get-effectivename bn_lst)
       (if (= x itm)
  (set (setq dd (read itm)) (setq cnt (1+ cnt)))
       )
     )
   )
  fnl_lst
 )
 (foreach nmbr fnl_lst
   (print nmbr)
   (princ (eval (read nmbr)))
   (princ)
 )
)

 

Change the layer name filter to suit your needs

 

NOTE:

there are no error catch on this code.. so pardon if it crashes

[Lee Mac]

Hi pBe,

 

Your function is quite inefficient in that you are iterating through the same list of information a number of times, to improve efficiency, try to minimise the number of iterations:

 

(defun c:test ( / _assoc++ i ss e lst ) (vl-load-com)

 (defun _assoc++ ( key lst / pair )
   (if (setq pair (assoc key lst))
     (subst (cons key (1+ (cdr pair))) pair lst)
     (cons  (cons key 1) lst)
   )
 )

 (if (setq i -1 ss (ssget "_X" '((0 . "INSERT") (8 . "Layername1,Layername2"))))
   (progn
     (while (setq e (ssname ss (setq i (1+ i))))
       (setq lst (_assoc++ (vla-get-EffectiveName (vlax-ename->vla-object e)) lst))
     )

     (print lst)
   )
 )

 (princ)
)

You could set variables using the effective name and taking the value of the count from the resultant list, but I don't see this as a good way to handle the information.

Edited October 25, 2010 by Lee Mac

[alanjt]

It's really a shame that assoc and subst are such underused functions.

[Lee Mac]

It's really a shame that assoc and subst are such underused functions.

 

True - because they are pretty quick and quite elegant when used in situations that warrant their use - I think perhaps most users tend to restrict their usage to dealing with 'entget' list manipulation.

[alanjt]

True - because they are pretty quick and elegant when used in situations that warrant their use - I think perhaps most users tend to restrict their usage to dealing with 'entget' list manipulation.

Precisely.

Hell, until about 6-8 months ago, I had never used them for anything except with entget. I had something similar to this, I was wanting to calculate the area of each contour and return the total area for each elevation (had several contours for the same elevation - multiple stage pond with berm).

[pBe]

Lee,

The part where you assign Variables is missing in your code which is the whole point of the routine.

 

Your function is quite inefficient in that you are iterating through the same list of information a number of times, to improve efficiency, try to minimise the number of iterations

 

You're right.. i idid go thru the same list more than once or twice

I originally wrote it this way...

 

(defun btv (/)
(setq  ol_blks (ssget "x" '((0 . "INSERT")(8 . "Layername1,Layername2"))) cnt 0 bn_lst nil)
         (while (< cnt (sslength ol_blks))
     (setq bn_lst (cons
            (vla-get-EffectiveName (vlax-ename->vla-object (ssname ol_blks cnt ))) bn_lst) cnt (1+ cnt))
    )

(foreach itm (LM:Unique  bn_lst) 
    (setq rslt (- (length bn_lst)(length (vl-remove itm bn_lst))))
        (set (setq dd (read itm)) rslt)
     (print itm)(princ (itoa rslt))(princ)
 )
  )

;;;;; Lee Mac 2010 ;;;;;
(defun LM:Unique ( l )
   (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
  )

 

I even throw in your duplicate routine .. to which i found out is what they call Recursive programming,

 

I just thought of trying my hand with Lamda and mapcar maybe thats why it ended up like the way it did

 

It's really a shame that assoc and subst are such underused functions.

 

Come to think of it Alanjit, yeah you're right, i'll try to use it more often in the future

 

Now... whats the problem again ?

[Lee Mac]

The part where you assign Variables is missing in your code which is the whole point of the routine.

 

Yeah, I did actually make a note about that at the bottom of my post....

[pBe]

I guess you did.. apologies Lee

 

(foreach itm [color=sienna](LM:Unique  bn_lst) ;;;;<--------[/color]
    (setq rslt (- (length bn_lst)(length (vl-remove itm bn_lst))))
        (set (setq dd (read itm)) rslt)
     (print itm)(princ (itoa rslt))(princ)
 )
  )

 

do you think that its a good idea to call the duplicate routine at this line?

does it run the LM:Unique code every after item on the list? should i just assigned a variable name for it?

[Lee Mac]

You can see the order of evaluation using the 'animate' utility in the VLIDE - it will highlight each statement as it is evaluated.

 

You could use something like this to test:

 

(defun sub ( / l )
 (foreach x '(1 2 3 4 5 6 7 8 9)
   (setq l (cons x l))
 )
 (reverse l)
)

(defun main nil
 (foreach x (sub)
   (print x)
 )
 (princ)
)

You should find that the 'sub' function is only evaluated once, then foreach operates on each element of the list supplied to it by 'sub'.

 

Anyway, back to your code... I see what you are trying to achieve and your code, as it stands, should work; but if you want my suggestions, there are a few ways you could improve its efficiency:

 

You are currently running 3 passes of the information: 1) Get list of block names 2) Remove duplicates from this list 3) Get/set variable to block count

 

You could quickly reduce this to 2 passes by detecting duplicates in the first pass hence:

 

(while (< cnt (sslength ol_blks))
   (if (not (member (setq n (vla-get-EffectiveName (vlax-ename->vla-object (ssname ol_blks cnt))))))
     (setq bn_list (cons n bn_list))
   )
 )

But of course, this would have an effect on your later method to list the occurences of each block.

 

Another way to reduce the number of passes is to combine the functions to create a unique list and list the occurrences, perhaps something like this:

 

(defun LM:ListOccurrences ( lst )
 ;; © Lee Mac 2010
 (if lst
   (cons
     (cons (car lst)
       (- (length lst) (length (vl-remove (car lst) lst)))
     )
     (LM:ListOccurrences (vl-remove (car lst) lst))
   )
 )
)

However, I still think your best option is the method used by my code above in which the list is passed once to retrieve the blocks/counts.

 

If you really wanted to set the variables, you could use something like this on the result (of course, we are back to 2 passes):

 

(mapcar '(lambda ( pair ) (set (read (car pair)) (cdr pair))) <result>)

I suppose to combine everything into one, single pass, you could use something like this:

 

(defun c:test ( / i ss e n ) (vl-load-com)

 (if (setq i -1 ss (ssget "_X" '((0 . "INSERT") (8 . "Layername1,Layername2"))))
   (progn
     (while (setq e (ssname ss (setq i (1+ i))))
       (setq n (read (vla-get-EffectiveName (vlax-ename->vla-object e))))

       (set n (cond ((eval n) (1+ (eval n))) ( 1 )))
     )
   )
 )

 (princ)
)

But then you would have to remember to localise all those dynamically created variables too, else you will get erroneous results on the second pass...

 

As I said, I much prefer list manipulation - after all, that is what LISP was designed for.

 

Lee

[pBe]

 

(defun LM:ListOccurrences ( lst )
;; © Lee Mac 2010
(if lst
(cons
(cons (car lst)
(- (length lst) (length (vl-remove (car lst) lst)))
)
(LM:ListOccurrences (vl-remove (car lst) lst))
)
)
)

 

Recursive programming

Difficult... so difficult....

 

Thanks for the codes Lee... I'll save it on my LeeMac_Made_Me_Understand folder

[Lee Mac]

Recursive programming

Difficult... so difficult....

 

Ah - its only practice

 

Thanks for the codes Lee... I'll save it on my LeeMac_Made_Me_Understand folder

 

You're welcome - did you understand what I was saying about the number of passes? if there is anything you don't understand just ask.

Edited October 26, 2010 by Lee Mac

[pBe]

did you understand what I was saying about the number of passes? if there is anything you don't understand just ask.

 

 

Yes, now i understand.. the Animate tool from VLIDE showed me how many times it process the list... never use any of them tools before, i used to write my codes using Q.EXE DOS mode to check parenthesis matching. and sometimes just plain old notepad. i went over some of the codes i wrote before.. cheese and rice.. most of them are a memory hog... neat tool Animate

 

reading thru your codes made me aware about a lot of functions i ignored in the past i.e eval, lambda, apply... i tend to stay away from them, maybe because i'm too lazy to study it but you showed me how powerful this functions are..

 

Thank you Lee/Allan

 

Really grateful for this Forum

[Lee Mac]

You're welcome

 

Just wondering:

 

.. cheese and rice..

 

What does this mean?