Jump to content

Recommended Posts

Posted (edited)

Hi,

 

I made a dynamic block with many action parameters. Two of the parameters need to be equal, but Autocad doesn't accept formulas for action parameters. 

 

D1 and D2 must be equal to OHd custom parameter

 

Could this be done with Lisp?

 

Something like:

 

1. select blocks

2. run lisp: for each block, pick OHd value (different for each block) and add it in D1 and D2 parameters.

 

Thanks

 

 

 

 

Cattura.PNG

Edited by whosa
Posted

IMHO, For sure it's possible - but why don't you try on your own...

Posted
2 minutes ago, marko_ribar said:

IMHO, For sure it's possible - but why don't you try on your own...

 

becouse  my knowledge of LISP is limited  

Posted
2 minutes ago, marko_ribar said:

Those parameters are specific for Dynamic Blocks - look here : http://www.lee-mac.com/dynamicblockfunctions.html

 I tried  it without success.

 

;; Set Dynamic Block Property Value  -  Lee Mac
;; Modifies the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
;; val - [any] New value for property
;; Returns: [any] New value if successful, else nil

(defun LM:setdynpropvalue ( blk D1 OHd )
    (setq D1 (strcase D1))
    (vl-some
       '(lambda ( x )
            (if (= D1 (strcase (vla-get-propertyname x)))
                (progn
                    (vla-put-value x (vlax-make-variant OHd (vlax-variant-type (vla-get-value x))))
                    (cond (OHd) (t))
                )
            )
        )
        (vlax-invoke blk 'getdynamicblockproperties)
    )
	(princ)
)

 

Posted

Try this quickie & untested program. :) 

(defun c:Test (/ int sel ent get tag ohd lst new)
  ;;	Tharwat - Date: 26.Mar.2022	;;
  (and (princ "\nSelect attributed blocks to replace D1 & D2 with OHd valye : ")
       (setq int -1 sel (ssget '((0 . "INSERT") (66 . 1))))
       (while (setq int (1+ int) ent (ssname sel int))
         (setq new ent lst nil)
         (while (not (eq (cdr (assoc 0 (setq get (entget (setq ent (entnext ent)))))) "SEQEND"))
           (setq lst (cons (list (cdr (assoc 2 get)) (cdr (assoc 1 get))) lst))
           )
         (and (= (length lst) 3)
              (setq ohd (assoc "OHd" lst))
              (while (not (eq (cdr (assoc 0 (setq get (entget (setq new (entnext new)))))) "SEQEND"))
                (and (wcmatch (setq tag (cdr (assoc 2 get))) "D1,D2")
                     (entmod (subst (cons 1 ohd) (assoc 1 get) get))
                     )
                )
              )              
       )
    )
  (princ)
)

 

  • Agree 1
Posted (edited)
4 hours ago, Tharwat said:

Try this quickie & untested program. :) 

(defun c:Test (/ int sel ent get tag ohd lst new)
  ;;	Tharwat - Date: 26.Mar.2022	;;
  (and (princ "\nSelect attributed blocks to replace D1 & D2 with OHd valye : ")
       (setq int -1 sel (ssget '((0 . "INSERT") (66 . 1))))
       (while (setq int (1+ int) ent (ssname sel int))
         (setq new ent lst nil)
         (while (not (eq (cdr (assoc 0 (setq get (entget (setq ent (entnext ent)))))) "SEQEND"))
           (setq lst (cons (list (cdr (assoc 2 get)) (cdr (assoc 1 get))) lst))
           )
         (and (= (length lst) 3)
              (setq ohd (assoc "OHd" lst))
              (while (not (eq (cdr (assoc 0 (setq get (entget (setq new (entnext new)))))) "SEQEND"))
                (and (wcmatch (setq tag (cdr (assoc 2 get))) "D1,D2")
                     (entmod (subst (cons 1 ohd) (assoc 1 get) get))
                     )
                )
              )              
       )
    )
  (princ)
)

 

 

 

Many thanks. I tried it but i get this error:

 

Select attributed blocks to replace D1 & D2 with OHd valye :
Select objects: 0 found
Select objects: 0 found, 0 total

 

Attached you can find a test file. 

TEST.dwg

Edited by whosa
Posted

Look at this

 

(setq blk (vlax-ename->vla-object (entlast)))
(LM:setdynpropvalue blk "DoorWidth"  (* x 25.4))

 

The property is a string so is your D1= "D1"

 

Revert back to Lee's original code and do your ifs and buts before calling LM:setdynpropvalue

Posted (edited)
11 hours ago, whosa said:

 

 

Many thanks. I tried it but i get this error:

 

Select attributed blocks to replace D1 & D2 with OHd valye :
Select objects: 0 found
Select objects: 0 found, 0 total

 

 

There was no error but the goal of the program was targeting attributed blocks and not dynamic blocks with parameters and that was my misunderstanding with your request.

Anyway, please try the following :

 

(defun c:Test (/ int sel ent blk val prp prs rtn lst)
  ;;	Tharwat - Date: 27.Mar.2022	;;
  (and (princ "\nSelect Dynamic blocks to replace D1 & D2 with OHd value : ")
       (setq lst '("OHd" "D1" "D2")
             int -1
             sel (ssget '((0 . "INSERT"))))
       (while (setq int (1+ int) ent (ssname sel int))
         (and (= (vla-get-IsDynamicBlock (setq blk (vlax-ename->vla-object ent))) :vlax-true)
              (setq prs (vlax-invoke blk 'getdynamicBlockproperties))
              (mapcar '(lambda (u)
                         (and (vl-position (setq prp (vla-get-propertyname u)) lst)
                              (or (and (= prp (car lst)) (setq val (vlax-get u 'Value)))
                                  (setq rtn (cons u rtn))
                                  )
                              )
                         )
                      prs)
              val rtn
              (mapcar '(lambda (u) (vlax-put u 'Value val)) rtn)
              (setq rtn nil)
              )
         )
       )
  (princ)
) (vl-load-com)

 

Edited by Tharwat
  • Thanks 1
Posted

This :

 

...

(and

  ...

  val rtn

  ...

)

...

 

Should be :

 

...

(and

  ...

  (setq val rtn)

  ...

)

...

Posted

I think you need to reread the routine once again before judging. ;) 

Posted

Yes, I see - you declared both of them before...

Sorry for my blunder...

Posted
3 hours ago, Tharwat said:

 

There was no error but the goal of the program was targeting attributed blocks and not dynamic blocks with parameters and that was my misunderstanding with your request.

Anyway, please try the following :

 

(defun c:Test (/ int sel ent blk val prp prs rtn lst)
  ;;	Tharwat - Date: 27.Mar.2022	;;
  (and (princ "\nSelect Dynamic blocks to replace D1 & D2 with OHd value : ")
       (setq lst '("OHd" "D1" "D2")
             int -1
             sel (ssget '((0 . "INSERT"))))
       (while (setq int (1+ int) ent (ssname sel int))
         (and (= (vla-get-IsDynamicBlock (setq blk (vlax-ename->vla-object ent))) :vlax-true)
              (setq prs (vlax-invoke blk 'getdynamicBlockproperties))
              (mapcar '(lambda (u)
                         (and (vl-position (setq prp (vla-get-propertyname u)) lst)
                              (or (and (= prp (car lst)) (setq val (vlax-get u 'Value)))
                                  (setq rtn (cons u rtn))
                                  )
                              )
                         )
                      prs)
              val rtn
              (mapcar '(lambda (u) (vlax-put u 'Value val)) rtn)
              (setq rtn nil)
              )
         )
       )
  (princ)
) (vl-load-com)

 

 

thanks, work perfect. 💪

Posted
5 minutes ago, whosa said:

 

thanks, work perfect. 💪

You're welcome anytime. :) 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...