Program for Cary Hulse

[Lee Mac]

You're welcome Cary

[Least]

Just in case anyone was watching...

 

And thanks again to LeeMac!! - this has been a massive workflow improvement for us and also a great learning experience for me.

 

Hello Chulse,

 

out of interest could you post an example csv file and a drawing file showing the results?

 

Thanks

[chulse]

Hello Chulse,

 

out of interest could you post an example csv file and a drawing file showing the results?

 

Thanks

 

PM me your email and I'll send you a sample set - too large to post here...

[chulse]

Ok, Help please

 

I just found that this routine doesn't like the UCS to be anything but WORLD.

What would be the best way to handle this?

I think you could use a command call to set the UCS to world at the beginning of the code and use the same to return it to the previous UCS at the end?

Is there a better way?

[Lee Mac]

Just a simple trans should do it:

 

;|
<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
TCOT-TREE BLOCK INSERTER
READS FROM CSV FILE (TREE#, CANOPY RADIUS, CRD RADIUS, CRZ RADIUS) AND SETS ATTRIBUTE AND DYNAMIC PROPERTIES.
ALLOWS BREAK/RESUME
January 2010

CARY HULSE
With MAJOR help from Lee Mac (Lee McDonnell [leebob3@hotmail.com] (www.cadtutor.net/forum/member.php?u=16898)
<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
|;

(defun c:tree (/ *error* StrBrk BNME DDEL DOC FILE LNAME NL OBJ OFILE PT SPC TAG UFLAG VALLST X CRZ CRD CANOPY)
 
 ;; by Lee Mac ~ 06.01.10
 
 (setq lname "LJ-PLNT-TREE") ;; Layer Name
 (setq  BNme "TCOT-TREE" ) ;; Block Name, MUST BE IN SUPPORT PATH AS DWG
 
 (vl-load-com)
 (setq DOC (vla-get-ActiveDocument (vlax-get-acad-object)))
   
 ;; --{  Error Handler Function  }--

 (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))  
   
 ;; --{  StrBrk Function  }-- By Lee Mac

 (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)))

 ;; CHECK FOR LAYER AND ADD IF NOT EXIST
 
 (or (tblsearch "LAYER" Lname)
     (vla-add (vla-get-layers doc) Lname))
     
 ;;***********MAIN FINCTIONS**************
 
 ;;COUNTER FUNCTION
 
 
 (if (and *lst* (not (initget "Start Continue")))
 (setq *lst* (if (= "Start" (getkword "\n[s]tart of File or [C]ontinue? <Continue> : ")) nil *lst*)))

(or *lst* (setq *rot* nil))

 
 (if (and (or (tblsearch "BLOCK" bNme)
              (setq bNme (findfile (strcat BNme ".dwg"))))           
          (or  *lst* (setq file (getfiled "Select Input File" (cond (*load_file*)  ("")) "csv;txt" 16))) 
          (or *ROT* (setq *ROT*  (cond ((getangle "\nEnter Block Rotation Angle <0.0> : ")) (0.0)))))
           
   (progn
     (setq uflag (not (vla-StartUndoMark doc))

           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)))
     
     
     (if (not *lst*)
       (progn
         (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 (trans pt 1 0)) bNme 1. 1. 1. *ROT*))))
                                   
         (princ "\n** Error Inserting Block **")
         (progn
           (vla-put-layer obj lname)

           (vla-put-TextString
             (car
               (vl-remove-if-not
                 (function
                   (lambda (x) (eq "TREE#" (strcase (vla-get-TagString x)))))
                 
                 (vlax-invoke Obj 'GetAttributes))) (car x))

                 
           (if (eq :vlax-true (vla-get-isDynamicBlock obj))
             (progn
             (setq ValLst (mapcar 'cons '("CANOPY RADIUS" "CRD RADIUS" "CRZ RADIUS")
                    (mapcar
                      (function
                        (lambda (i)
                          (if (equal 0.0 (distof i) 0.0001) "1" i)))
                      (list (cadr x) (caddr x) (cadddr x)))))

             
                   (foreach dAtt (vlax-safearray->list
                               (vlax-variant-value
                                 (vla-GetDynamicBlockProperties obj)))

                 (if (setq tag (assoc (strcase (vla-get-propertyName dAtt)) ValLst))
                   (vla-put-value dAtt
                     (vlax-make-variant (cdr tag)                        
                       (vlax-variant-type (vla-get-value dAtt))))))))))
 
         (princ (strcat "Tree# " (car x)))
       (setq *lst* (cdr *lst*)))

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

 (princ))

[chulse]

Just a simple trans should do it:

 

 

Excellent! One I got it in the right place it works perfect. Much easier than my way. Thanks.

[Lee Mac]

On[c]e I got it in the right place it works perfect.

 

It should already be in the code above ...

[chulse]

It should already be in the code above ...

 

It was.

Instead of blindly copy/pasting - I wanted to try to understand what you did. When I added it to my copy, I forgot to remove the preceeding pt, so it didn't work until I figured that out.

 

Again, thanks for the education.

[Lee Mac]

It was.

Instead of blindly copy/pasting - I wanted to try to understand what you did. When I added it to my copy, I forgot to remove the preceeding pt, so it didn't work until I figured that out.

 

Again, thanks for the education.

 

You're welcome