Jump to content

Replace block attribute values


Russello

Recommended Posts

Hi again legends. I need your help once again. I dont know how to replace/set block attribute values when I insert it via lisp if it has more than 1 line (vertically).

 

If it is only one line (horizontally), I know how. for example I have 4 tags, so the code goes:

 

(command "-Insert" "Sampleblock" "_non" Data_block aa ""
                  LineValue1
                  LineValue2
                  BearingValue
                  DistanceValue
                   )

(assuming all values were set and achieved)

But when I'm dealing with attributes more than 1 line (vertically), I dont know how. Sample Image fE9nrR

 

Is there a way to write in a lisp that says set the value of POINT1 with this, POINT2 with this, and goes on.

 

P.S. I already know (maybe hehehe) how to get the values that I want, I just dont know how to set them as values on the inserted block when it is more than 1 line vertically.

 

Thanks again for your help. kudos :)

Link to comment
Share on other sites

You should upload dwg of that block for testing.

 

The following code works for my made on-the-fly test block:

 

(defun C:test ( / fuzz e enx s srt1 srt2 ans p px L i )
 (and 
   (setq fuzz 1e-1) ; adjust
   (setq e (car (nentsel "\nPick attribute: ")))
   (setq enx (entget e))
   (member '(0 . "ATTRIB") enx)
   (setq s (getstring t "\nText prefix: "))
   (mapcar 'set '(srt1 srt2)
     (if (setq ans (progn (initget "Row Column") (= "Column" (cond ((getkword "\nSpecify [Row/Column] <Column>: "))("Column")))))
       (list car cadar)
       (list cadr caar)
     )
   )
   (setq p (cdr (assoc 10 enx)))
   (progn 
     (foreach x (vlax-invoke (vlax-ename->vla-object (cdr (assoc 330 enx))) 'GetAttributes)
       (and (equal (srt1 p) (srt1 (setq px (vlax-get x 'InsertionPoint))) fuzz) 
         (setq L (cons (list px x) L))
       )
     )
     (if L (setq L (vl-sort L '(lambda (a b) ((if ans > <) (srt2 a) (srt2 b))))))
   ); progn
   (setq i 0)
   (foreach x (mapcar 'cadr L)
     (vlax-put x 'TextString (strcat s (itoa (setq i (1+ i)))))
   )
 ); and
 (princ)
); defun C:test 

AttribBlockTable.dwg

Link to comment
Share on other sites

I've copied Grrr's code and I modified it slightly in case you want Vanilla ALISP... @Grrr, if you use (vla-xxx) functions, you should not forget to write also (vl-load-com)...

 

(defun C:test ( / fuzz e enx s srt1 srt2 ans p blk att px L i )
 (and 
   (setq fuzz 1e-1) ; adjust
   (setq e (car (nentsel "\nPick attribute : ")))
   (setq enx (entget e))
   (member '(0 . "ATTRIB") enx)
   (setq s (getstring t "\nText prefix : "))
   (mapcar 'set '(srt1 srt2)
     (if (setq ans (progn (initget "Row Column") (= "Column" (cond ((getkword "\nSpecify [Row/Column] <Column>: "))("Column")))))
       (list car cadar)
       (list cadr caar)
     )
   )
   (setq p (cdr (assoc 10 enx)))
   (progn
     (setq blk (cdr (assoc 330 enx)))
     (setq att (entnext blk))
     (while att
       (and
         (= (cdr (assoc 0 (entget att))) "ATTRIB")
         (equal (srt1 p) (srt1 (setq px (cdr (assoc 10 (entget att))))) fuzz) 
         (setq L (cons (list px att) L))
       )
       (setq att (entnext att))
     )
     (if L (setq L (vl-sort L '(lambda ( a b ) ((if ans > <) (srt2 a) (srt2 b))))))
   ); progn
   (setq i 0)
   (foreach x (mapcar 'cadr L)
     (entupd (cdr (assoc -1 (entmod (subst (cons 1 (strcat s (itoa (setq i (1+ i))))) (assoc 1 (entget x)) (entget x))))))
   )
 ); and
 (princ)
); defun C:test

Edited by marko_ribar
Link to comment
Share on other sites

Could not resist my $0.05

 

Would a Table work better as you can keep adding rows ?

 

; By Alan H
; 3 line dcl
; sample code (ah:getval3 "Row No" 5 4 "Column No" 5 4 "New value" 20 18)

(defun AH:getval3 (title1 width1 limit1 title2 width2 limit2 title3 width3 limit3 / fo fname)
(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
;(setq fo (open (setq fname "c:\\ACADTEMP\\GETVAL.DCL") "w"))
(write-line "ddgetval3 : dialog {" fo)
(write-line " : column {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title1 (chr 34) ";" ) fo)
(write-line (strcat "     edit_width = " (rtos width1 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit1 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key2" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title2 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width2 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit2 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key3" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title3 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width3 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit3 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line "ok_only;}" fo)
(close fo)

; code part
(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetval3" dcl_id))
(exit))
(mode_tile "key1" 3)
(action_tile "key1" "(setq val1 $value)")
(mode_tile "key2" 3)
(action_tile "key2" "(setq val2 $value)")
(mode_tile "key3" 3)
(action_tile "key3" "(setq val3 $value)")
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
; returns the value of val1 val2 and val3 as strings
(vl-file-delete fname)
) ; defungetval3

Screen Shot 10-20-17 at 01.25 PM.PNG

Link to comment
Share on other sites

Hi all. Thank you Master Grr, marko_ribar, and BIGAL. You have provided good solutions but it is not really what Im looking for, it's not your fault it was mine. The way I wrote my problem seems to general. Anyways, I found a solution (maybe) and I will give it a shot. please keep in touch Master because I know I will face a lot of problems. hehehe.

 

I've seen these functions at the acadauto.chm (autodesk shared files) and I think this is what im looking for.

(vlax-variant-value (vla-GetAttributes. . .
(vla-put-TextString (vlax-safearray-get-element. . . .

 

Hoping Im on the right path but with your guidance, nothing to worry. hehehe

 

Regards,

Russello

Link to comment
Share on other sites

No problem Marko,

Thanks for the reminder about (vl-load-com), I had a discussion with Roy before about loading it and ended up with (or vlax-get-acad-object (vl-load-com)).

BTW if you wanted pure vanilla then the vl-sort function should be substituted with a custom one.

 

Rusello,

BIGAL posted somewhere a simple example how to assign a value to the nth attribute.

Maybe that was here or in a more previous thread.

But that approach relies on the attribute's creation order.

Link to comment
Share on other sites

@Grrr, not all prefixed "vl-" functions are (vl-load-com) dependent... I have a list of those functions and among them is also (vl-sort)... So my version is Vanilla - you may call it that as it don't need (vl-load-com) invoked at all...

 

Here is list of those functions FYI :

 

VL-ACAD-DEFUN

VL-ACAD-UNDEFUN

VL-ARX-IMPORT

VL-BB-REF

VL-BB-SET

VL-BT

VL-BT-OFF

VL-BT-ON

VL-CATCH-ALL-APPLY

VL-CATCH-ALL-ERROR-MESSAGE

VL-CATCH-ALL-ERROR-P

VL-CMDF

VL-CONSP

VL-DIRECTORY-FILES

VL-DOC-EXPORT

VL-DOC-IMPORT

VL-DOC-REF

VL-DOC-SET

VL-EVERY

VL-EXIT-WITH-ERROR

VL-EXIT-WITH-VALUE

VL-FILE-COPY

VL-FILE-DELETE

VL-FILE-DIRECTORY-P

VL-FILE-RENAME

VL-FILE-SIZE

VL-FILE-SYSTIME

VL-FILENAME-BASE

VL-FILENAME-DIRECTORY

VL-FILENAME-EXTENSION

VL-FILENAME-MKTEMP

VL-GET-RESOURCE

VL-INFP

VL-INIT

VL-LIST->STRING

VL-LIST-EXPORTED-FUNCTIONS

VL-LIST-LENGTH

VL-LIST-LOADED-VLX

VL-LIST*

VL-LOAD-ALL

VL-LOAD-COM

VL-LOAD-REACTORS

VL-MEMBER-IF

VL-MEMBER-IF-NOT

VL-MKDIR

VL-NANP

VL-POSITION

VL-PRIN1-TO-STRING

VL-PRINC-TO-STRING

VL-PROPAGATE

VL-REGISTRY-DELETE

VL-REGISTRY-DESCENDENTS

VL-REGISTRY-READ

VL-REGISTRY-WRITE

VL-REMOVE

VL-REMOVE-IF

VL-REMOVE-IF-NOT

VL-SOME

VL-SORT

VL-SORT-I

VL-STRING->LIST

VL-STRING-ELT

VL-STRING-LEFT-TRIM

VL-STRING-MISMATCH

VL-STRING-POSITION

VL-STRING-RIGHT-TRIM

VL-STRING-SEARCH

VL-STRING-SUBST

VL-STRING-TRANSLATE

VL-STRING-TRIM

VL-SYMBOL-NAME

VL-SYMBOL-VALUE

VL-SYMBOLP

VL-UNLOAD-VLX

VL-VBALOAD

VL-VBARUN

VL-VLX-LOADED-P

VLARTS-INIT

VLAX-ADD-CMD

VLAX-FOR

VLAX-REMOVE-CMD

VLISP-DCLRES-LIST

VLISP-DCLRES-LOAD-DIALOG

VLISP-EXPORT-SYMBOL

VLISP-FASRES-LIST

VLISP-FASRES-LOAD

VLISP-IMPORT-EXSUBRS

VLISP-IMPORT-SYMBOL

VLISP-INIRES-LIST

 

Regards, M.R.

Link to comment
Share on other sites

Grr you are correct (setq atts (vla-GetAttributes then a (put (nth x atts) whilst it will work with rows and columns you do need to know how many of each exist was the block created x x x x y y y y z z z or x y z x y z and so on. Working out correct attribute is easy, the code would have to be hard coded for say how many columns.

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