Modify current routine-block a

Cad64 · 发表于 2022-7-6 11:32:47

Ok guys, I've got a routine that I've been using for about 4 years. I can't remember who wrote it for me, it might have been CAB, but I need some extra functionality added to it.

This may be a little difficult to explain, but here's some background on the routine and why I need it to do what it does and why I need it modified. I design cemeteries, which sometimes involves laying out a field of grave spaces. These spaces are generally placed into blocks of 4 or 8 or 16 or whatever. Each block has an attribute block number and each space has an attribute text string indicating space number and block number.

So for example, I have a block of 4 grave spaces and the block is number 100. The number 100 is an attribute. Each individual space within the block is numbered with plain text 1, 2, 3 & 4, (This text does not need to change). Each individual space also has an attribute string indicating the block number and space number like this: 100-1, 100-2, 100-3 & 100-4.

So, whenever we need to renumber a field of blocks, all attributes within each block needs to update at once. So if block number 100 needs to be changed to 101, then the attribute strings also need to update to 101-1, 101-2, 101-3 & 101-4. My routine does this perfectly, but the problem is that I have to initiate the command, type in the new number and select the block to update. Then I have to repeat the process again and again and again for every block on the map. Not only is this tedious and time consuming, but it leaves room for error if I happen to type in the wrong number, which I have been known to do from time to time.

What I would like the routine to do is:
1. Ask me for the starting block number
2. Allow me to select the block to update
3. Update attributes as described above
4. Loop and increment +1
5. Allow me to select the next block to update
6. Update attributes as described above
7. Continue looping, incrementing and updating until I end the routine

Can one of you guys please take a look at the attached code and see if you can modify it to make this happen? It would save hours of tedious re-numbering. I have also included a dwg for you to run tests on.

If this explanation was confusing, let me know. Thanks in advance.

copy

;;;;Routine to modify all attributed crypt space numbers within a block simultaneously;;(defun c:AM (/ ss BlkObj tmpStr pos val) (vl-load-com) (or *prefix* (setq *prefix* "100")) (setq val (getstring (strcat "\nInput New *prefix*: : "))) (if (or (null val) (= val ""))   (setq val *prefix*)   (setq *prefix* val) ) (princ "\nSelect Block to update...") ; only blocks with attributes (if (setq ss (ssget ":S" (list (cons 0 "INSERT") '(66 . 1))))   (progn     (setq BlkObj (vlax-ename->vla-object (ssname ss 0)))     (foreach attrib (vlax-safearray->list (variant-value (vla-getattributes BlkObj)))       (setq tmpStr (vla-get-textstring attrib)             pos (vl-string-position 45 tmpStr) ; find the "-"       )       (if pos         (progn           (setq tmpStr (vl-string-subst *prefix* (substr tmpStr 1 pos) tmpStr))           (vla-put-textstring attrib tmpStr)         )         (vla-put-textstring attrib *prefix*)       )     )   ) ) (princ))(prompt "\nAttribute Updater loaded, Enter AM to run.")(princ)

LC-4.dwg

Lee Mac · 发表于 2022-7-6 11:37:59

I may have misunderstood, but was it something like this you were looking for?

copy

(defun c:AttInc (/ ss att str pos) (vl-load-com) (or *start (setq *start 100)) (setq *start (cond ((getint (strcat "\nSpecify Starting Number  : ")))                    (*start))) (princ "\nSelect Block to Increment: ") (while (setq ss (ssget "_:S" '((0 . "INSERT") (66 . 1))))   (foreach att (vlax-invoke                  (vlax-ename->vla-object (ssname ss 0)) 'GetAttributes)          (setq str (vla-get-TextString att))     (vla-put-TextString att       (if (setq pos (vl-string-position 45 str))         (strcat (itoa *start) (substr str (1+ pos)))         (itoa *start))))      (setq *start (1+ *start))) (princ))

Cad64 · 发表于 2022-7-6 11:40:35

Thanks Lee, damn you're quick! That's close but not quite. Your routine is only updating the individual space attribute strings. It needs to update the block number attribute as well.

Lee Mac · 发表于 2022-7-6 11:44:09

Just spotted that! Updated.

Cad64 · 发表于 2022-7-6 11:47:10

Oh man, that's perfect! Thank you so much. This will make life much easier.

Thanks again.

Lee Mac · 发表于 2022-7-6 11:51:14

You're welcome Rod

Cad64 · 发表于 2022-7-6 11:52:08

Hey Lee, I just discovered a small issue with the routine. Whenever I have a number smaller than 10 and I try to type in something like 06, it only displays 6. It discards the zero. I would like for it to display the zero in front of the number. Is there a way to make this happen?

Thanks

Lee Mac · 发表于 2022-7-6 11:57:09

Hi Rod,

Yes, the issue arises as the program uses getint to retrieve an integer, and '06' is recognised as just '6'. To get around this issue I can use a string prompt, and convert it.

alanjt · 发表于 2022-7-6 11:58:25

What about this (untested)? I hope you don't mind Lee.

copy

(defun c:AttInc (/ _Fix ss att str pos) (vl-load-com) (setq _Fix (lambda (x)              (if (< *start 10)                (strcat "0" (itoa *start))                (itoa *start)              ) ;_ if            ) ;_ lambda ) ;_ setq (or *start (setq *start 100)) (setq *start (cond ((getint (strcat "\nSpecify Starting Number  : ")))                    (*start)              ) ;_ cond ) ;_ setq (princ "\nSelect Block to Increment: ") (while (setq ss (ssget "_:S" '((0 . "INSERT") (66 . 1))))   (foreach att (vlax-invoke                  (vlax-ename->vla-object (ssname ss 0))                  'GetAttributes                ) ;_ vlax-invoke     (setq str (vla-get-TextString att))     (vla-put-TextString       att       (if (setq pos (vl-string-position 45 str))         (strcat (_Fix *start) (substr str (1+ pos)))         (_Fix *start)       ) ;_ if     ) ;_ vla-put-TextString   ) ;_ foreach   (setq *start (1+ *start)) ) ;_ while (princ)) ;_ defun

Lee Mac · 发表于 2022-7-6 12:03:55

Was just about to post this actually:

copy

(defun c:AttInc (/ MStr ss att str pos num) (vl-load-com) (setq mStr (lambda (string) (while (< (strlen string) len)                               (setq string (strcat "0" string))) string)) (or *start (setq *start "100")) (while   (not     (setq num        (distof         (setq *start           (cond ((/= "" (setq tmp (getstring (strcat "\nSpecify Starting Number  : ")))) tmp)                 (*start))))))) (setq len (strlen *start) num (fix num)) (princ "\nSelect Block to Increment: ") (while (setq ss (ssget "_:S" '((0 . "INSERT") (66 . 1))))   (foreach att (vlax-invoke                  (vlax-ename->vla-object (ssname ss 0)) 'GetAttributes)          (setq str  (vla-get-TextString att))          (vla-put-TextString att       (if (setq pos (vl-string-position 45 str))         (strcat (setq *start (mStr (itoa num))) (substr str (1+ pos)))         (setq *start (mStr (itoa num))))))      (setq num (1+ num))) (princ))

Updated to correct while loop.

[编程交流] Modify current routine-block a

发表回复

精选推荐