Reference drawing stamp

[BILL WILLIAMS]

I do not know how to write code in any shape, form or fashion and I have a request to those who know how to do such things.

I am using R2007 and my request is for a stamp that would be automatically put on every drawing that is opened.

What I would like is REFERENCE DRAWING in Romans.shx placed on the drawing approximately 2" vertically and approximately 1/2" horizonally from 0,0.

The text size to be approximately 1/4" high for an A size sheet but changing as the paper size increases. (A, B, C, D, E)

Is this possible?

Either way, I thank you very much for your help.

Bill Williams

[Grant]

Why not make what you want as a DWG and insert it on the drawing - or put it into your template file?

[BILL WILLIAMS]

That is a good way to do it but we have borders provided by corporate and the powers-to-be here want a text line that will automatically insert. They want to keep corporaate happy.

[alanjt]

Inserting the text is easy, but changing the size (since you don't have access to annotative objects) is more of a challenge.

Consider the following:

Does the object need to be in model or paper?

What change is made to alter the size (eg. dimscale variable, viewport scale)?

[Lt Dan's legs]

What's the titleblock name?

Are they all different names or is it a dynamic block?

[BILL WILLIAMS]

It would work better if it is in paper space and as to the text size it would be better if it was large enough on a e size sheet to read easily.

The title block/border is supplied by corporate, as I mentioned earlier, with attributes for drawing description, etc.

[Grant]

Make a notepad file acaddoc.lsp

 

(defun S::STARTUP()

(setq title_block "corporatetitleblock")

(setq ent (cdr (assoc 2 (tblnext "block" T))))

(while (/= ent nil)

(if (= ent title_block)(command "insert" "C:\\myfile\\mydrg.dwg" "0,0" "1" "1" "0"))

(setq ent (cdr (assoc 2 (tblnext "block"))))

)

)

 

This will search all the blocks in the drawing and if it finds the corporate title block inserts your drawing at 0,0

 

Hope this helps

[BILL WILLIAMS]

I just wanted the words REFERENCE DRAWING to insert every time a drawing was opened at the location prescribed earlier

[Lee Mac]

Quickly hacked together, put this in your ACADDOC.lsp Bill:

 

(defun c:RefDWG ( / str pos hgt ) (vl-load-com)

 (setq str  "REFERENCE DRAWING" ;; Text String
       pos '(0.5 2.0 0.0)       ;; Text Position
       hgt  0.25                ;; Text Height
 )

 (vla-AddText
   (vla-get-PaperSpace
     (vla-get-ActiveDocument
       (vlax-get-acad-object)
     )
   )
   str (vlax-3D-point pos) hgt
 )
 (princ)
)
(c:RefDWG)

 

Or more robust to account for current locked layer:

 

(defun c:RefDWG ( / str pos hgt ) (vl-load-com)

 (setq str  "REFERENCE DRAWING" ;; Text String
       pos '(0.5 2.0 0.0)       ;; Text Position
       hgt  0.25                ;; Text Height
 )

 (if
   (vl-catch-all-error-p
     (vl-catch-all-apply 'vla-AddText
       (list
         (vla-get-PaperSpace
           (vla-get-ActiveDocument
             (vlax-get-acad-object)
           )
         )
         str (vlax-3D-point pos) hgt
       )
     )
   )
   (princ (strcat "\n** Error Creating Text: " str " **"))
 )
 (princ)
)
(c:RefDWG)

[BILL WILLIAMS]

Thank you Lee.

I will try it first thing after the Thanksgiving holiday

[alanjt]

??

 

(defun foo (/ ss)
 (foreach layout (layoutlist)
   (or (setq ss (ssget "_X" (list '(8 . "REFERENCE-TEXT") '(0 . "MTEXT") (cons 410 layout))))
       (entmakex (list '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbMText")
                       '(10 0.5 2.0 0.0)
                       '(1 . "REFERENCE TEXT")
                       '(8 . "REFERENCE-TEXT")
                       '(40 . 0.25)
                       (cons 410 layout)
                 )
       )
   )
 )
)

[Lee Mac]

You're welcome Bill

[JohnM]

Bill,

Is this for one computer or multiple computers?

Do you want it to be automatic when any drawing is opened or do you want to type a command to run it?

Is this only for a particular client or for any drawing opened?

[BILL WILLIAMS]

Lee, I couldn't wait. Had to try it before I left for the day. I can't seem to get it to work.

Attached is my acaddoc.lsp and I attached the RefDWG at the bottom.

Where did I go wrong?

 

;;Automated acaddoc creation 7:57 AM 8/23/2010 theswamp.org

;;Write all files in a directory (and possibly subdirectories) to load in the ACADDOC.lsp

;;If the ACADDOC.lsp is not found, it will be created in the SavePath as shown at the top of the code.

;;Although, for large numbers of files, I would suggest looking into the AutoLoad function to save memory.

 

(defun c:acaddoc ( / SavePath f l )

(vl-load-com)

;; © Lee Mac 2010

(setq SavePath

(cond

 

( (setq tmp (getvar 'ROAMABLEROOTPREFIX))

(or (eq "\\" (substr tmp (strlen tmp)))

(setq tmp (strcat tmp "\\")))

(strcat tmp "Support\\")

)

( (setq tmp (findfile "ACAD.pat"))

(setq tmp (vl-filename-directory tmp))

(or (eq "\\" (substr tmp (strlen tmp)))

(setq tmp (strcat tmp "\\")))

tmp

)

(t

(popup "Warning" 16 "DCL Save Path not Valid")

(exit)

)

)

)

(or (setq f (findfile "ACADDOC.lsp"))

(setq f (strcat SavePath "ACADDOC.lsp"))

)

(if (and (setq l (LM:GetAllFiles nil T "*.lsp"))

(setq f (open f "a")))

(progn

(foreach x l

(write-line

(strcat "(load "

(vl-prin1-to-string x) " \"Failed to Load: " (vl-filename-base x) "\")"

)

f

)

)

(close f)

(princ (strcat "\nWritten " (itoa (length l)) " Files to Load in ACADDOC.lsp"))

)

(princ "\n*Cancel*")

)

(princ)

)

;;--------------------=={ Get All Files }==-------------------;;

;; ;;

;; Retrieves all files or those of a specified filetype that ;;

;; reside in a directory (and subdirectories) ;;

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

;; Author: Lee McDonnell, 2010 ;;

;; ;;

;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;

;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;

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

;; Arguments: ;;

;; Dir - [str] (optional) Directory, if nil function will ;;

;; prompt for directory selection ;;

;; subs - [boole] if T, subdirectories are included ;;

;; filetype - [str] (optional) Filter for filetype ;;

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

;; Returns: VLA Variant Object of type specified ;;

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

(defun LM:GetAllFiles ( Dir Subs Filetype / GetSubFolders Shell Fold Dir )

(vl-load-com)

;; © Lee Mac 2010

 

(defun GetSubFolders ( folder / _f )

(mapcar

(function

(lambda ( f ) (setq _f (strcat folder "\\" f))

(cons _f (apply (function append)

(GetSubFolders _f)))

)

)

(cddr (vl-directory-files folder nil -1))

)

)

(cond

( (not

(or

(and Dir (vl-file-directory-p Dir))

(progn

(setq Shell (vla-getInterfaceObject

(setq ac (vlax-get-acad-object)) "Shell.Application")

Fold (vlax-invoke-method Shell 'BrowseForFolder

(vla-get-HWND ac) "Select Directory" 512))

(vlax-release-object Shell)

 

(if Fold

(progn

(setq Dir (vlax-get-property

(vlax-get-property Fold 'Self) 'Path))

(vlax-release-object Fold)

 

(and (= "\\" (substr Dir (strlen Dir)))

(setq Dir (substr Dir 1 (1- (strlen Dir)))))

 

Dir

)

)

)

)

)

nil

)

( (apply (function append)

(vl-remove (quote nil)

(mapcar

(function

(lambda ( Filepath )

(mapcar

(function

(lambda ( Filename )

(strcat Filepath "\\" Filename)

)

)

(vl-directory-files Filepath Filetype 1)

)

)

)

(append (list Dir)

(apply (function append)

(if subs (GetSubFolders Dir))

)

)

)

)

)

)

)

)

defun c:RefDWG ( / str pos hgt ) (vl-load-com)

(setq str "REFERENCE DRAWING" ;; Text String

pos '(0.5 2.0 0.0) ;; Text Position

hgt 0.25 ;; Text Height

)

(vla-AddText

(vla-get-PaperSpace

(vla-get-ActiveDocument

(vlax-get-acad-object)

)

)

str (vlax-3D-point pos) hgt

)

(princ)

)

(c:RefDWG)

[alanjt]

You are missing a paren for this line: (defun c:RefDWG

 

Did you try my submission?

[BILL WILLIAMS]

Thanks Alan for spotting that paren. I haven't had a chance to try yours. Does your load the same way, with acaddoc?

[alanjt]

Just follow everything with (foo).

[BILL WILLIAMS]

Alan, I don't understand

Just follow everything with (foo).

 

They're getting ready to lock the doors so I have to go!

Talk to you again Monday and again THANKS!