Lisp to adjust rotation and rotation parameter of blocks in model from a list of blocknames.

[Jo_Deknudt]

Hi all,

I'm still new to lisp and autolisp.
I have blocks that have a rotation parameter spread over several drawings.

now my supervisor asked me to write a script that changes the rotation of the blocks to 0 and puts the rotation parameter to the correct angle. also the parameter is locked to either 0° or 90° deg so I was thinking of using a sort of translation matrix or a simple vla-put-property for rotation and a move alone X or Y. (see defun 

translate_block that i've commented out as a template)

Edit: working with Autocad 2019 still if this matters.

Now, for the first bit. I'm trying to get my loops and structure of the function straight.
I've tried approaching this with vla-select to get the block objects from modelspace.
for visuals I'm running through the items and princ where I am in the function. At the end I get an error. see the end of this post.

For the second bit I could use some pointers. this function will have to receive the list of blocknames and only change the blocks from this list. granted the rotation is not 0. however dont know how to approach this. is it possible to make a new selectionset and handle the rotation and move actions from there? see vsset in the code attached.

Command: TEST
test started
- invoking function: "process-block-rotation"
filter_code
filter_value
fill filter_code
fill filter_value
Command: length of newsset = 20.000
Enter loop --
0 > Block 0.000/20.000 with name Naaldafsluiter has rotation: 270.00 <
1 > Block 1.000/20.000 with name Klepafsluiter has rotation: 270.00 <
2 > Block 2.000/20.000 with name Diafragma Kraan has rotation: 270.00 <
3 > Block 3.000/20.000 with name Bolkraan has rotation: 270.00 <
4 > Block 4.000/20.000 with name *U130 has rotation: 270.00 <
5 > Block 5.000/20.000 with name Naaldafsluiter has rotation: 180.00 <
6 > Block 6.000/20.000 with name Klepafsluiter has rotation: 180.00 <
7 > Block 7.000/20.000 with name Diafragma Kraan has rotation: 180.00 <
8 > Block 8.000/20.000 with name Bolkraan has rotation: 180.00 <
9 > Block 9.000/20.000 with name *U130 has rotation: 180.00 <
10 > Block 10.000/20.000 with name Naaldafsluiter has rotation: 90.00 <
11 > Block 11.000/20.000 with name Klepafsluiter has rotation: 90.00 <
12 > Block 12.000/20.000 with name Diafragma Kraan has rotation: 90.00 <
13 > Block 13.000/20.000 with name Bolkraan has rotation: 90.00 <
14 > Block 14.000/20.000 with name *U130 has rotation: 90.00 <
1516171819
Error: bad argument type: FILE "20.000"Regenerating model.

Command:
-- deleting ssets after error

[ВeekeeCZ]

The error is quite simple, missing strcat

(princ (strcat "total items =" (rtos sslen)))

[Jo_Deknudt]

Thanks for replying.
I feel like a dud. 🙂

any pseudo code to help me with the general problem?

[ВeekeeCZ · Accepted solution]

Well, I would use just one loop and do that simultaneously.

(vlax-for item newsset
  (princ ctr)
  (setq check (and
		(vlax-property-available-p item "Rotation" T)
                (setq currentrotation (vlax-get-property item 'Rotation))
		(not (equal currentrotation 0))
		))
  
  (if check
    (progn

      (cond

	((equal currentrotation 0)
	 T)
	
	((equal currentrotation (/ pi 2) 1e-6)
	 (vl-catch-all-apply 'vla-put-rotation (list item (- ( / pi 2))))
	 (LM:setdynpropvalue item "Angle1" 0))
	
	(princ (strcat " > Block " (rtos ctr) "/" (rtos sslen)
		       " with name " (vlax-get-property item 'Name)
		       " has rotation: " (angtos (vlax-get-property item 'Rotation) 0 2)
		       "changed to.... " "whatever---"
		       " <\n"
		       ))
	
	
	
	) ;
      
      
      (setq ctr (1+ ctr)) ;; count changed items
      )
    (princ (strcat "changed " (rtos ctr)) " from " (itoa sslen))))

[Jo_Deknudt]

Thank you BeeKeeCZ for the help so far. o7

i've updated it like attached. however vlax-for seems to run out of keys.

it does not interfere with the script but it does raise some questions. 🙂
Is there a way to fix this? searching for it I came up empty

2nd question: How should I handle the unnassigned blocknames? the block "Afsluiter" seems to be given the name "*U18"

- 23.000 > Block 23.000/25.000 with name Diafragma Kraan has current rotation: 0.000, therefore did not change changed item23.000 of 25

- 24.000 > Block 24.000/25.000 with name Bolkraan has current rotation: 0.000, therefore did not change changed item24.000 of 25

- 25.000 > Block 25.000/25.000 with name *U18 has current rotation: 0.000, therefore did not change changed item25.000 of 25
"--- total items = 25.000"
delete ssets
Regenerating model.

Command:
Error: Automation Error. Key not foundRegenerating model.

Command: Automation Error. Key not found

[ВeekeeCZ]

It's this line within *error* that cause the trouble. You're deleting the already deleted ss1 selection set.

(if (vla-delete (vla-item ssets "SS1")) (print "-- deleting ssets after error\n"))

Do you even need the *error*? Managing attdia/attreq sysvars is kinda pointless, at least at this moment... you can get it back if you find it useful...

[Sea-Haven · Accepted solution]

When you get a block from the selection use the "Effectivename" not the block name, say "*U123" has the effective name "AFSLUITER", a normal block both name and effective name will be the same. 

EffectiveName (RO) = "Naaldafsluiter"

Name = "Naaldafsluiter"

[Jo_Deknudt]

hey all, I managed to fix it.

I realize this snippet could use its own function inside the progn's but for now I'm sattisfied.

thanks all who helped.

  (vlax-for item newsset
    (setq check (and 
                  (vlax-property-available-p item "Rotation" T)
                  (setq currentRotation (vlax-get-property item 'Rotation))
                  (eq (vlax-get-property item 'EffectiveName)  Blockname)
                  ;(not (equal currentRotation 0))
                )
    ) ; setq check
    (if check
      (progn
        ;(vlax-dump-object item)
        (princ (strcat  "\n\n- " (rtos ctr) " > Block " (rtos ctr) "/" (rtos sslen)
                        " with name " (vlax-get-property item 'EffectiveName)
                        ;" with placement: " currInsertionPoint
                        " has rotation: " (angtos currentRotation 0 2)
               )
        )
        (cond
          (   (equal currentRotation (angtof "0")) (progn (princ "0, therefore did not change")))
          (   (equal currentRotation (angtof "90")) (progn 
                                                      (vla-put-rotation item 0)
                                                      (LM:setdynpropvalue item "Angle1" 90)
                                                      (princ (strcat " and changed to " (angtos(vlax-get-property item 'Rotation))))
                                                    ))
          (   (equal currentRotation (angtof "180")) (progn
                                                       (vla-put-rotation item 0)
                                                       (vla-Move item (vlax-3d-point 0 0 0)(vlax-3d-point -4 0 0))
                                                       (LM:setdynpropvalue item "Angle1" 0)
                                                       (princ (strcat " and changed to " (angtos(vlax-get-property item 'Rotation))))
                                                     ))
          (   (equal currentRotation (angtof "270")) (progn 
                                                       (vla-put-rotation item 0)
                                                       (vla-Move item (vlax-3d-point 0 0 0)(vlax-3d-point 0 -4 0))
                                                       (LM:setdynpropvalue item "Angle1" 90)
                                                       (princ (strcat " and changed to " (angtos(vlax-get-property item 'Rotation))))
                                                     ))
          (T (princ (strcat " not a straight angle in item " (rtos ctr) " of " (itoa sslen))))
        ); cond
        ;(princ (strcat "changed to.... " "whatever---" " <\n"))
        
        (setq ctr (1+ ctr)) ;; count changed items
      ); progn
    ) ;if check
  ) ; vla-for

[Jo_Deknudt]

Just one more question. I'm trying to pass the blocks names that are allowed to be adjusted.
Is there a way to filter this in the selectionset?
It's not as simple as this. it seems.

(setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 410 "MODEL")(cons 2 bname))))

anyone know? 
Edit: see full code attached.

;list 
(setq 2wayvalves '(;("Block2" ("OldAttName2.1" "NewAttName2.1") ("OldAttName2.2" "NewAttName2.2") ("Old2.3" "new2.3"")) ; Example
                      ("TERUGSLAGKLEP" ("KLNR" "KLNR"))
                      ("AFSLUITER" ("KLNR" "TAG"))
                     )
)

(defun proces-2wayvalves (bname / *error* #acadDocument ssets newsset 
                               filter_code filter_value
                              ) 
  ;load the visual lisp extensions
  (vl-load-com)
  (princ "\n  - invoking function: \"proces-2wayvalves\" for block --> ")
  (princ bname)


  (setq #acadDocument (vla-get-activedocument (vlax-get-acad-object)))

  (setq ssets (vla-get-selectionsets #acadDocument))
(vlax-get-acad-object))) "SS1"))
  (setq newsset (vla-add ssets "SS1"))
  ;create a n-1 element array for the DXF Code
  (setq filter_code (vlax-make-safearray vlax-vbinteger '(0 . 1)))
  ;create a n-1 element array for the value
  (setq filter_value (vlax-make-safearray vlax-vbvariant '(0 . 1)))
  (vlax-safearray-fill filter_code '(0 410))
  ;the filter value
  (vlax-safearray-fill filter_value '("INSERT" "MODEL"))
  ;(setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 410 "MODEL")(cons 2 (vla-get-EffectiveName bname)))))
  ;(setq newsset (vlax-ename->vla-object ss))
  ;Select all blocks
  (vla-select newsset acSelectionSetAll nil nil filter_code filter_value)
  (setq sslen (vla-get-count newsset))
;; Do stuff
)
(defun c:test ()
(foreach block 2wayvalves
  (proces-2wayvalves (car block))
)
)

[ВeekeeCZ · Accepted solution]

No. Code 2 holds real names, not effective names. 

You might narrow down the selection by using (ssget '((2 . "`*U*"))) filter but still, it will select ALL anonymous references of dynamic blocks.

When you insert a dynblock, it holds its original name UNTIL you change any of its dyn properties. Then it creates an anonymous reference. Use this line to explore

(cdr (assoc 2 (entget (car (entsel "sel dyn block:")))))

[Jo_Deknudt]

Thank you all for pointing these bugs out.
i've learned alot!

[Sea-Haven]

Like BeekeeCZ "You might narrow down the selection by using (ssget '((2 . "`*U*")))" you can increase the block filter part and then check for effective name  (ssget '((2 . "`*U*,block1,block2")))" sometimes its just easier to do  (ssget '((0 .  "INSERT"))) and look at effective name comparing to say a list of block names.

[Jo_Deknudt]

My idea was to highlight the changes the script made after each run of the function.

I think I'm better off putting those items in another item list as it is being changed based on the rotation.

then highlighting that new list at the end of the function.

but it would hinder the flow of updating the 100-ish files. so, still contemplating to add that idea or not.

[Jo_Deknudt]

Hi,

So I finally managed to finish my scope of the script.
Today I had some troubles with an infinitesimal small difference when checking for rotation it would just skip the block because the rotation wasn't equal to a value.

I've tried using an (equal fuzz 1e-6) but it would skip certain blocks/

Even when turning all the "angtof "90") and other angles to its Pi Radians equivalent It would still skip them.

I stopped looking for the most smallest tolerance to fuzz for.

So I managed to use this dirty fix to force a non infinitesimal value.

(vlax-put-property item 'Rotation (angtof (angtos (vlax-get-property item 'Rotation) 0 3) 0)); forcing rotation with 0.001 accuracy

i've put it inside the loop before it starts checking and handling each block.

Perhaps you have another suggestion? Always looking to learn. 😉

[ВeekeeCZ]

 (equal angdiff 0 1e-6) might be too high even for radians... how about 1e-4.

BUT you also need to consider that angles could be around zero; one is 1°, the second 359°, and the difference is still <= 2°. (example in degrees for better understanding)

(or  (equal angdiff 0 1e-6)  (equal angdiff (* 2 pi) 1e-6))  ;; comparing radians.