Help with auto numbering attributes left to right

[Anonymous]

Hello everyone,

There are 2 problems I am facing.

1. Auto re-numbering/re-naming attributes 

     a. Select blocks

     b. Ask user for prefix

     c. Ask user for starting number

     c. Number the selected blocks in numerical order from left to right incorporating the prefix and starting where the           user entered  

2. Stretch a dynamic block's stretchy grip to a selected polyline 

     a. Select blocks 

     b. Select polyline 

     c. Pulls stretchy block to polyline similar to extend but for blocks  🙂

Here is a drawing showing whats going on, hope this is clear enough.

Does anyone have any code that will do the first problem? 

And for the second problem..... is this even possible??? If so how would you go about it? 

I can do simple things in lisp but this is surpasses my understanding... 

Thanks in advanced for all the helpful information!

[ronjonp]

You could modify the code HERE to easily number your attributes.

[marko_ribar · Accepted solution]

For your second problem :

(defun c:stdynbladeblks ( / *adoc* ss c i b p pp d )

  (vl-load-com)

  (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vla-endundomark *adoc*)
  )
  (vla-startundomark *adoc*)
  (while
    (or
      (prompt "\nSelect BLADE dynamic blocks...")
      (not (setq ss (ssget "_:L" '((0 . "INSERT") (2 . "`*U*")))))
    )
    (prompt "\nEmpty sel.set...")
  )
  (while
    (or
      (not (setq c (car (entsel "\nPick curve entity you want to extend/trim Blade dynamic blocks to..."))))
      (if c
        (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list c)))
      )
    )
    (prompt "\nMissed or picked wrong entity type...")
  )
  (repeat (setq i (sslength ss))
    (setq b (ssname ss (setq i (1- i))))
    (if (= (vla-get-effectivename (vlax-ename->vla-object b)) "Blade")
      (progn
        (setq p (cdr (assoc 10 (entget b))))
        (setq pp (vlax-curve-getclosestpointtoprojection c p '(0.0 1.0 0.0)))
        (if (and (> (cadr pp) (cadr p)) (= (vla-get-rotation (vlax-ename->vla-object b)) 0.0))
          (setq d (distance p pp))
          (if (equal (vla-get-rotation (vlax-ename->vla-object b)) pi 1e-6)
            (setq d (distance p pp))
            (prompt "\nDistance property negative - unable to stretch reverse...")
          )
        )
        (if d
          (setpropertyvalue b "AcDbDynBlockPropertyDistance1" d)
        )
      )
    )
  )
  (vla-endundomark *adoc*)
  (princ)
)

Regards, M.R.

[CodeDing · Accepted solution]

@Anonymous ,

For your first problem..

(defun c:PROB1 ( / ss cnt e pref prefZ txt num)
(vl-load-com)
;get selection set from user
(setq ss nil)
(while (not ss)
  (prompt "\nSelect \"Blade\" blocks: ")
  (if (setq ss (ssget '((0 . "INSERT"))))
    (progn
      (setq cnt (sslength ss))
      (while (>= (setq cnt (1- cnt)) 0)
	(setq e (ssname ss cnt))
	(if (not (eq "Blade" (getpropertyvalue e "BlockTableRecord/Name")))
	  (ssdel e ss)
	);if
      );while
      (if (= 0 (sslength ss)) (setq ss nil))
    );progn
  ;else
    (prompt "No blocks found...")
  );if
);while
;get prefix & number from user
(initget 1)
(setq pref (strcase (getstring "\nPrefix String: ")))
(initget 7);use 6 if you want to include 0
(setq num (getint "\nStarting Number: "))
;order blocks in sel set from left to right (small x to big x)
(if (> (sslength ss) 0) (setq ss (_SortSSByXValue ss)))
;loop through selection set, combining prefix and #s
(setq cnt -1)
(repeat (sslength ss)
  (setq e (ssname ss (setq cnt (1+ cnt))))
  (setq prefZ (nth (1- (strlen (itoa num))) '("000" "00" "0" "")))
  (setq txt (strcat pref prefZ (itoa num)))
  (setpropertyvalue e "BNAME" txt)
  (setq num (1+ num))
);repeat
;finish up
(setq ss nil)
(prompt "\nComplete...")
(princ)
);defun

(defun _SortSSByXValue (ss / lst i e add)
;by: alanjt (https://forums.augi.com/showthread.php?137837-Sort-Selectionset-by-X-coord)
  (if (eq (type ss) 'PICKSET)
    (progn
      (repeat (setq i (sslength ss))
        (setq lst (cons (cons (setq e (ssname ss (setq i (1- i))))
                              (cadr (assoc 10 (entget e)))
                        )
                        lst
                  )
        )
      )
      (setq add (ssadd))
      (foreach e (vl-sort lst (function (lambda (a b) (< (cdr a) (cdr b))))) (ssadd (car e) add))
      (if (> (sslength add) 0)
        add
      )
    )
  )
)

Best,

~DD

[Anonymous]

Thank you to both of you for helping me with this matter, you have no idea what a nightmare this would be without it! 

They are perfect!