Program for Cary Hulse

Thanks for the interest in my Point Manager program Cary, I realise that it didn't quite meet your needs, and so hopefully this will

(defun c:attpop (/ *error* StrBrk                 

                  ALST ATT BNME DDEL DOC FILE LST NL OBJ OFILE PT SPC UFLAG X Y )
 
 ;; by Lee Mac ~ 01.01.10
 (vl-load-com)

 (defun *error* (msg)
   (and ofile (close ofile))
   (and uflag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 

 (defun StrBrk (str chrc / pos lst)
   (while (setq pos (vl-string-position chrc str))
     (setq lst (cons (substr str 1 pos) lst)
           str (substr str (+ pos 2))))
   (reverse (cons str lst)))
 

 (if (and (setq bNme (getfiled "Select Block to Insert" (cond (*block_file*) ("")) "dwg"     16))
          (setq file (getfiled "Select Input File"      (cond (*load_file*)  ("")) "txt;csv" 16)))
   (progn
     
     (setq uflag (not (vla-StartUndoMark
                        (setq doc (vla-get-ActiveDocument
                                    (vlax-get-acad-object)))))

           spc (if (zerop (vla-get-activespace doc))
                 (if (= (vla-get-mspace doc) :vlax-true)
                   (vla-get-modelspace doc)
                   (vla-get-paperspace doc))
                 (vla-get-modelspace doc)))
     
     (setq dDel (if (eq ".CSV" (strcase (vl-filename-extension file))) 44 32)
           *block_file* bNme *load_file* file ofile (open file "r"))

     (while (setq nl (read-line ofile))
       (setq lst (cons (StrBrk nl dDel) lst)))
     
     (setq ofile (close ofile) lst (reverse lst))

     (while (and (setq x  (car lst))
                 (setq pt (getpoint "\nSpecify Point for Block: ")))

       (if (vl-catch-all-error-p
             (setq obj
               (vl-catch-all-apply (function vla-InsertBlock)
                 (list spc (vlax-3D-point pt) bNme 1. 1. 1. 0.))))
         (princ "\n** Error Inserting Block **")
         (progn
           (setq aLst (vlax-invoke obj 'GetAttributes))

           (while (and (setq y   (car x))
                       (setq att (car aLst)))              
             (vla-put-TextString att y)
             (setq x (cdr x) aLst (cdr aLst)))))
       
       (setq lst (cdr lst)))

     (setq uFlag (vla-EndUndoMark doc))))
 
 (princ))

Happy New Year!

Lee

Awesome Lee, Thanks!

I'll be playing with it today (back to work )

I am re-building my main template so it couldn't have come at a better time

Well, I couldn't resist...

Let me know how you get on!

Could I ask you to comment it out a bit like you did that last one for me if you have time?

This is all I have time for:

(defun c:attpop (/ *error* StrBrk                 

                  ALST ATT BNME DDEL DOC FILE LST NL OBJ OFILE PT SPC UFLAG X Y )
 
 ;; by Lee Mac ~ 01.01.10

 ;; --{ Commented Version }--
 
 (vl-load-com) ;; Load Visual LISP Console
 

 ;; --{  Error Handler Function  }--

 (defun *error* (msg)  ;; Localised with variables
   
   (and ofile (close ofile)) ;; If ofile still non-nil, close the open file
   
   (and uflag (vla-EndUndoMark doc))  ;; If uflag still non-nil, End the Undo Mark.
   
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")  ;; Suppress Cancel messages
       
       (princ (strcat "\n** Error: " msg " **"))) ;; Print fatal errors
   
   (princ))

 ;; -----------------------------------------------


 ;; --{  StrBrk Function  }--

 ;; By Lee Mac  ~  Used to break a string into a list of elements,
 ;;                using a delimiter.

 (defun StrBrk (str chrc / pos lst)
   (while (setq pos (vl-string-position chrc str))
     (setq lst (cons (substr str 1 pos) lst)
           str (substr str (+ pos 2))))
   (reverse (cons str lst)))

 ;; -----------------------------------------------
 

 (if (and
       ;; Block selection

       (setq bNme (getfiled "Select Block to Insert" (cond (*block_file*) ("")) "dwg"     16))

       ;; Data File Selection
       (setq file (getfiled "Select Input File"      (cond (*load_file*)  ("")) "txt;csv" 16)))
   
   (progn

     ;; Start the Undo Mark before we proceed uflag = T
     
     (setq uflag (not (vla-StartUndoMark
                        (setq doc (vla-get-ActiveDocument
                                    (vlax-get-acad-object)))))

           ;; Get the Active Space

           spc (if (zerop (vla-get-activespace doc))
                 (if (= (vla-get-mspace doc) :vlax-true)
                   (vla-get-modelspace doc)
                   (vla-get-paperspace doc))
                 (vla-get-modelspace doc)))

     ;; Get the correct delimiter, if CSV, comma, else space.
     
     (setq dDel (if (eq ".CSV" (vl-filename-extension file)) 44 32)

           ;; Save the defaults for next time, and open the file, ofile = non-nil
           
           *block_file* bNme *load_file* file ofile (open file "r"))

     ;; Read the file and break the strings

     (while (setq nl (read-line ofile))
       (setq lst (cons (StrBrk nl dDel) lst)))

     ;; Close the file, ofile = nil  and reverse the lst.
     
     (setq ofile (close ofile) lst (reverse lst))

     ;; While there are attribs in the list, AND the user has clicked a point

     (while (and (setq x  (car lst))
                 (setq pt (getpoint "\nSpecify Point for Block: ")))

       ;; Catch any errors that occur when inserting the block
       
       (if (vl-catch-all-error-p
             (setq obj
               (vl-catch-all-apply (function vla-InsertBlock)
                 (list spc (vlax-3D-point pt) bNme 1. 1. 1. 0.))))
         
         (princ "\n** Error Inserting Block **")

         ;; Else populate the Attribs using the values in the list.
         (progn

           ;; Get a list of VLA-objects (attribs)
           (setq aLst (vlax-invoke obj 'GetAttributes))

           ;; While there is an attrib and value
           (while (and (setq y   (car x))
                       (setq att (car aLst)))
             
             ;; Populate the attribs
             (vla-put-TextString att y)
             (setq x (cdr x) aLst (cdr aLst)))))

       ;; Move onto next item
       (setq lst (cdr lst)))

     ;; End the Undo Mark,  uFlag = nil

     (setq uFlag (vla-EndUndoMark doc))))

 ;; Clean exit
 (princ))

Hope that helps a bit.

I'm sure it will, THANKS!

Ok, you have inspired me to take this further. I found some functions to populate dynamic properties and I am trying to add them to your code. This is a great start for me that I could have never done myself.

First though, I have changed your code to not ask for the block, but just use the one I need (it will always be the same).

My question is this: my block has only one attribute, but 3 dynamic (linear) properties. Currently, when I add the block, it populates the one attribute with all the values in the list seperated by commas. Is this how it was intended?

What I would like to try is to break up that list to only take the first value for the one attribute, then use the remainder for the other functions?

I will post what I have here in a bit...

Thanks again for your great help!

Ok, you have inspired me to take this further. I found some functions to populate dynamic properties and I am trying to add them to your code. This is a great start for me that I could have never done myself.

 

First though, I have changed your code to not ask for the block, but just use the one I need (it will always be the same).

 

My question is this: my block has only one attribute, but 3 dynamic (linear) properties. Currently, when I add the block, it populates the one attribute with all the values in the list seperated by commas. Is this how it was intended?

What I would like to try is to break up that list to only take the first value for the one attribute, then use the remainder for the other functions?

 

I will post what I have here in a bit...

Thanks again for your great help!

Wowzer... thanks for picking up on my typo! Missed the strcase when comparing file extensions. I have updated the first post.

I will try to help all I can Cary, but I warn you that I have no experience with Dynamic Blocks...

Ok, I think I am getting somewhere...

Can you help me make sure I understand this process/have things in the correct order?

I think this is where I am having a problem...

The whole code is attached.

(progn
           ;; Get a list of VLA-objects (attribs)
           (setq aLst (vlax-invoke obj 'GetAttributes)) ;;Can I assign this to the attribute tag "TREE#"?
           ;; While there is an attrib and value
           (while (and (setq TRNUM   (car x))
                       (setq att (car aLst))
  ;;;set variables for dynamic values, not sure if this is in the correct place?
  (setq CANOP (cadr x))
  (setq CRZ (caddr x))
  (setq CRD (cadddr x))
 );end and
             
             ;; Populate the attribs
             (vla-put-TextString att TRNUM)
             ;;(setq x (cdr x) aLst (cdr aLst));;;edited by CH - only one attribute in block
      
;;;Set Dynamic Properties using "myModifyBk" function
(myModifyBk (list "CRD Radius" CRD)) 
(myModifyBk (list "CRZ Radius" CRZ))
(myModifyBk (list "Canopy Radius" CANOP))
     
);end while
 );end progn

tree.lsp

What would I change here (assuming this is the right place) to default to CSV in the dialog box?

(setq file (getfiled "Select Input File"      (cond (*load_file*)  ("")) "txt;csv" 16)))

I think I figured out one problem - it was that the while loop is now not needed.

It seems to be working now.

I think I figured out one problem - it was that the while loop is now not needed.

It seems to be working now.

So are all your questions answered now?

Well,

Would it be possible to prompt for block rotation at the beginning of the routine? (they would all be the same)

Yes,

Instead of giving you the answer straight, I will give you the tools for the job

Make a prompt where you want it, and look into the getangle function, perhaps use an IF statement to allow for null input.

I used vla-insertblock to insert your blocks, the arguments are in the list following the function (due to the use of vl-catch-all-apply).

Look up vla-insertblock in the VLIDE help and you can see which of the arguments in the list is the rotation.

Hope this helps!

Lee

Cool, thanks. This has been a huge learning experience for me.

I posted earlier the bit that prompts for the CSV file - do you know how/if the dialog can default to CSV instead of TXT?

This is the code now (functional)

The functions manipulating the dynamic blocks were found here:

http://mdouglas.blogs.com/in_the_dynamic_interface/2005/07/dynamic_lisp_co.html

(my tree block is too big to attach)

tree2.lsp

I can't find vla-insertblock in the help file anywhere?

I posted earlier the bit that prompts for the CSV file - do you know how/if the dialog can default to CSV instead of TXT?

This should answer your questions:

(defun c:test ( )

 (getfiled "test" "" "txt;csv" 1)

 (getfiled "test" "" "csv;txt" 1)

 (princ))

I can't find vla-insertblock in the help file anywhere?

• Type VLIDE at command line

• Go to File > New File

• type vla-insertblock

• It should turn blue, recognising it as a function

• Double click on it, to highlight the whole word

• Click on the help symbol (yellowish icon, with blue question mark).

Lee

is it possible to set a default value for the getangle prompt (so the user can just hit enter)?

(and
       ;; Block selection
       (setq bNme "tcot-tree") ;;(getfiled "Select Block to Insert" (cond (*block_file*) ("")) "dwg"     16)) {{removed select block dialog option, force block to TCOT-TREE}}
       ;; Data File Selection
       (setq file (getfiled "Select Input File"      (cond (*load_file*)  ("")) "csv;txt" 16)) ;; could add "TXT" as file type...
   (setq ROT (getangle "Enter Block Rotation Angle:"))
   );end and

BTW, found the help bits, thanks!