whosa Posted March 26, 2022 Posted March 26, 2022 (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 Edited March 26, 2022 by whosa Quote
marko_ribar Posted March 26, 2022 Posted March 26, 2022 IMHO, For sure it's possible - but why don't you try on your own... Quote
whosa Posted March 26, 2022 Author Posted March 26, 2022 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 Quote
marko_ribar Posted March 26, 2022 Posted March 26, 2022 Those parameters are specific for Dynamic Blocks - look here : http://www.lee-mac.com/dynamicblockfunctions.html 1 Quote
whosa Posted March 26, 2022 Author Posted March 26, 2022 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) ) Quote
Tharwat Posted March 26, 2022 Posted March 26, 2022 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) ) 1 Quote
whosa Posted March 26, 2022 Author Posted March 26, 2022 (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 March 26, 2022 by whosa Quote
BIGAL Posted March 27, 2022 Posted March 27, 2022 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 Quote
Tharwat Posted March 27, 2022 Posted March 27, 2022 (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 March 27, 2022 by Tharwat 1 Quote
marko_ribar Posted March 27, 2022 Posted March 27, 2022 This : ... (and ... val rtn ... ) ... Should be : ... (and ... (setq val rtn) ... ) ... Quote
Tharwat Posted March 27, 2022 Posted March 27, 2022 I think you need to reread the routine once again before judging. Quote
marko_ribar Posted March 27, 2022 Posted March 27, 2022 Yes, I see - you declared both of them before... Sorry for my blunder... Quote
whosa Posted March 27, 2022 Author Posted March 27, 2022 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. Quote
Tharwat Posted March 27, 2022 Posted March 27, 2022 5 minutes ago, whosa said: thanks, work perfect. You're welcome anytime. Quote
Recommended Posts
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.