Jump to content

dynamic block distance lisp adjustment


sadefa

Recommended Posts

Hello to all.

 

I am complete lame about lisp programing. I need some help for automation of process I do manually and it’s driving me crazy.

I have a dynamic block, which has multiple custom properties – distances, which can be adjusted. Two of them are to adjust the distance from already present marks. The present marks are placed every 5 meters. The first one starts at 0 coordinate on X axis, so that they are placed on 0, 5, 10, 15, etc.

What I am looking for is a way to select multiple blocks and ask them to adjust the distances so that they end at the already known marks.

Thanks in advance.

 

sample.png

Link to comment
Share on other sites

My $0.05 why not just have the vertical lines based on character and how many, have a make function and an update function, just lines and text. There is a dynamic block drag and get more example, but read text val for spacing not sure. Could do a block attribute rather than text.

 

5 5 5 

5 5 5 5 5

5 5 5 3 2 5 5 5 5 etc.

 

Dynamic block would be fixed how many at moment is 17 what happens with 5 5 5 5 4 3 5 5 6 2 5 5 and so on.the 4 3 is 2 not 1, can see problems. 

Link to comment
Share on other sites

I'm not sure if this is how you like the script to help you.

Try it out, see if you want it differently.

 

 (vl-load-com)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; http://www.lee-mac.com/dynamicblockfunctions.html

;; Set Dynamic Block Visibility State  -  Lee Mac
;; Sets the Visibility Parameter of a Dynamic Block (if present) to a specific value (if allowed)
;; blk - [vla] VLA Dynamic Block Reference object
;; val - [str] Visibility State Parameter value
;; Returns: [str] New value of Visibility Parameter, else nil
(defun LM:SetVisibilityState ( blk val / vis )
    (if
        (and
            (setq vis (LM:getvisibilityparametername blk))
            (member (strcase val) (mapcar 'strcase (LM:getdynpropallowedvalues blk vis)))
        )
        (LM:setdynpropvalue blk vis val)
    )
)

;; 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 prp val )
    (setq prp (strcase prp))
    (vl-some
       '(lambda ( x )
            (if (= prp (strcase (vla-get-propertyname x)))
                (progn
                    (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
                    (cond (val) (t))
                )
            )
        )
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; http://www.lee-mac.com/attributefunctions.html
;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.
(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Dynamic Block Distance lisp Adjustment
(defun dbda ( ss lft rgt / i blk )
	(setq i 0)
	(repeat (sslength ss)
		(setq blk (vlax-ename->vla-object (ssname ss i)))
		;; TO DO: see if the block is "X_block"
		
		(LM:setdynpropvalue blk "Distance1" lft)
		(LM:vl-setattributevalue blk "X1" (itoa lft))
		
		(LM:setdynpropvalue blk "Distance2" rgt)
		(LM:vl-setattributevalue blk "X2" (itoa rgt))
		
		(setq i (+ i 1))
	)
)

(defun c:dbda ( / ss lft rgt )
		;; user set values and select objects
	(setq lft (getint "\nLeft value: "))
	(setq rgt (getint "\nRight value: "))
	(setq ss (ssget (list (cons 0 "INSERT"))))
		
	(dbda ss lft rgt)
	
	(princ)
)

 

  • Like 1
Link to comment
Share on other sites

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...