How to change the .PAT save location in GETPAT.LSP

[andrew_green]

I'm using the GETPAT.LSP from the following link [http://www.turvill.com/t2/free_stuff/] and would like to edit the LSP so that the command will save the .PAT file to this folder on my machine: C:\DESIGN CENTER\HATCH

Any help would be greatly appreciated.  I've also pasted the lisp as it is right now below:

;|

GETPAT.LSP (c) 2001 Tee Square Graphics
Version 1.01b - 1/22/2002

This routine may be used to extract hatch pattern data
from existing drawings when the .pat file containing
the original information is not available.

After loading the file in the usual manner, type the
command GETPAT at the AutoCAD Command: prompt, select
any (non-SOLID) hatch object, and the pattern information
will be written to a .pat file having the same name as
the pattern (e.g., pattern information for the hatch
pattern WOODS will be written to WOODS.PAT.

Ver. 1.01b includes two small fixex to eliminate "Bad
Argument" LISP errors when run with certain installations
of AutoCAD 2000+.

|;

(defun C:GETPAT (/ cmde hat elst rotn hnam temp xofs yofs what
temp outf flin angl tmp1 tmp2 xvec yvec)
(setq cmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(while (not (setq hat (entsel "\nSelect hatch: "))))
(setq elst (entget (car hat)))
(if (= (cdr (assoc 0 elst)) "HATCH")
(progn
(setq rotn (* 180 (/ (cdr (assoc 52 elst)) pi))
hnam (cdr (assoc 2 elst))
hscl (cdr (assoc 41 elst))
)

;; The following nine lines may optionally be omitted.
;; Their purpose is to create a temporary "clone" of the
;; selected hatch with a 0 deg. rotation angle, in case
;; the hatch object specified a rotation angle. If these
;; lines are omitted, the current rotation of the selected
;; hatch will become the "0" deg. rotation for the extracted
;; pattern definition.
(if (not (zerop rotn))
(progn
(setq temp elst)
(entmake temp)
(command "_.rotate" (entlast) "" (cdr (assoc 10 temp))(- rotn))
(setq elst (entget (entlast)))
(entdel (entlast))
)
)
;; End of optional code.

(setq xofs (cdr (assoc 43 elst))
yofs (cdr (assoc 44 elst))
elst (member (assoc 53 elst) elst)
)
(setq outf (strcat hnam ".pat"))
(if (findfile outf)
(progn
(initget "Overwrite Append")
(setq what (getkword (strcat "\n" outf " already exists; Overwrite/Append? ")))
)
)
(setq outf (open outf (if (= what "Append") "a" "w"))
flin (strcat "*" hnam)
)
(foreach x elst
(cond
((= (car x) 53)
(write-line flin outf)
(setq angl (cdr x)
flin (trim (angtos angl 0 7))
)
)
((= (car x) 43)
(setq flin (strcat flin ", " (trim (rtos (/ (- (cdr x) xofs) hscl) 2 7))))
)
((= (car x) 44)
(setq flin (strcat flin "," (trim (rtos (/ (- (cdr x) yofs) hscl) 2 7))))
)
((= (car x) 45)
(setq tmp1 (cdr x))
)
((= (car x) 46)
(setq tmp2 (cdr x)
xvec (/ (+ (* tmp1 (cos angl))(* tmp2 (sin angl))) hscl)
yvec (/ (- (* tmp2 (cos angl))(* tmp1 (sin angl))) hscl)
flin (strcat flin ", " (trim (rtos xvec 2 7)) "," (trim (rtos yvec 2 7)))
)
)
((= (car x) 49)
(setq flin (strcat flin ", " (trim (rtos (/ (cdr x) hscl) 2 7))))
)
((= (car x) 98)
(write-line flin outf)
)
(T nil)
)
)
(write-line "" outf)
(close outf)
(alert (strcat hnam " pattern definition written to " hnam ".PAT"))
)
(alert "Selected object not a HATCH.")
)
(setvar "cmdecho" cmde)
(princ)
)
(defun trim (x / n)
(setq n (strlen x))
(while (= (substr x n 1) "0")
(setq n (1- n)
x (substr x 1 n)
)
)
(if (= (substr x n 1) ".")
(setq x (substr x 1 (1- n)))
)
x
)
(princ)

[paullimapa · Accepted solution]

Search & replace this line of code:

(setq outf (strcat hnam ".pat"))

with this line of code:

(setq outf (strcat "C:\\DESIGN CENTER\\HATCH\\" hnam ".pat"))

Area Object Link | Attribute Modifier | Dwg Setup | Feet-Inch Calculator
Layer Apps | List on Steroids | VP Zoom Scales |Exchange App Store

[xico_gda]

hi, im trying to use getpat to recover a custom hatch that i have in an old draw but nothing happen, and i realy need to recover this hatch.

I'm using autocad 2015 student-version.

[hanslammerts]

Hello, i'm picking up this old post. Happen to ran into the same issue here.

To be honest,  the provided sollution is only a half one.

GETPAT.LSP is a great tool but there is one thing that needs to be done.

GETPAT will put the .pat files in the directory where you start up AutoCAD

A challenge for somebody who is good in lisp, who can rewrite it so that setvar DWGPREFIX will be used to get it to work immediately

Without the finding and moving stuff.

This will lead you to the 2003 version of that file. 

http://www.turvill.com/t2/free_stuff/getpat.lsp

Here is a brief demo of this wonderful routine!

https://youtu.be/AYopx8ibhtQ

[paullimapa]

pretty simple to set the current drawing path to the location where the *.pat would be created.

Just change one line of code located under this section:

      (setq xofs (cdr (assoc 43 elst))
            yofs (cdr (assoc 44 elst))
            elst (member (assoc 53 elst) elst)
      )
      (setq outf (strcat hnam ".pat")) ; line of code to change

 to:

      (setq xofs (cdr (assoc 43 elst))
            yofs (cdr (assoc 44 elst))
            elst (member (assoc 53 elst) elst)
      )
      (setq outf (strcat (getvar"dwgprefix") hnam ".pat")) ; new line of code

Area Object Link | Attribute Modifier | Dwg Setup | Feet-Inch Calculator
Layer Apps | List on Steroids | VP Zoom Scales | Exchange App Store

[hanslammerts]

Thanks pli!

[hanslammerts]

I managed to add this to the message.

This routine is great for dealing with Revit DWG.

Revit makes custum hatches named FP_xx 'Fill Parttern _random number'

[hanslammerts]

This is a nice piece of code to work with it to clean some things up form Revit 

that will put all the hatches on appropriate layers (you probably will get a lot..) 

;; put hatches on layers on layers x-hatch-....
;; credits Grrr Cadtutor.net
;; use Lee Mac EXNEST to get rid of all block def. first

(defun C:getpatlayer ( / pref suf *error* SS acDoc Lyrs acSS pat )
  
  (setq ; Adjust to suit
    pref "x-hatch-"
    suf ""
  ); setq 
  
  (defun *error* (m)
    (and acSS (vla-Delete acSS))
    (and m (princ m)) (princ)
  ); defun *error*
  
  (cond 
    ( (setq SS (ssget "_X" '((0 . "HATCH")))) (setq Lyrs (vla-get-Layers (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))))
      (vlax-for o (setq acSS (vla-get-ActiveSelectionSet acDoc))
        (setq pat (strcat pref (vla-get-PatternName o) suf))
        (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list Lyrs pat))) (vla-Add Lyrs pat) )
        (vla-put-Layer o pat)
      ); vlax-for
      
    )
  ); cond
  (*error* nil) (princ))

[hanslammerts]

The code for 'GETPATLAYER' has been revised.

The idea is that the routines GETPAT and GETPATLAYER work together.

With the wildcard matches you can assign names and layer you like

Kind of funny to see Revit makes these .PAT files and then deletes them at the end. (..DOOOO!! why ??)

Check the video startpoint  https://youtu.be/I8c_aF4g3ZE?t=25

(defun C:getpatlayer (/           pref
                      suf         LM:SetLayerTransparency
                      *error*     SS
                      oCol        acDoc
                      Lyrs        acSS
                      pat         lyr
                      pref_eval
                      lcol
                     )                            ; https://www.theswamp.org/index.php?topic=52473.msg574082#msg574082
    (defun LM:SetLayerTransparency (lay trn / ent) ; Lee Mac
        (defun LM:trans->dxf (x) (logior (fix (* 2.55 (- 100 x))) 33554432))
        (cond
            ((not (<= 0 trn 90)) nil)
            ((if (setq ent (tblobjname "layer" lay))
                 (progn (regapp "accmtransparency")
                        (entmod
                            (append
                                (entget ent)
                                (list (list -3
                                            (list "accmtransparency"
                                                  (cons 1071 (LM:trans->dxf trn))
                                            )
                                      )
                                )
                            )
                        )
                 )
             )
            )
        )
    )                                             ; defun LM:SetLayerTransparency
    (defun *error* (m)
        (and acSS (vla-Delete acSS))
        (and (eq 'VLA-OBJECT (type oCol))
             (not (vlax-object-released-p oCol))
             (vlax-release-object oCol)
        )
        (and acDoc (vla-EndUndoMark acDoc))
        (and m (princ m))
        (princ)
    )                                             ; defun *error*
    (cond ((and (setq SS (ssget "_X" '((0 . "HATCH"))))
                (setq oCol (vla-GetInterfaceObject
                               (vlax-get-acad-object)
                               (strcat "AutoCAD.AcCmColor."
                                       (substr (getvar 'acadver) 1 2)
                               )
                           )
                )
                (setq Lyrs (vla-get-Layers (setq acDoc (vla-get-ActiveDocument
                                                           (vlax-get-acad-object)
                                                       )
                                           )
                           )
                )
           )                                      ; and 
           (vla-EndUndoMark acDoc)
           (vla-StartUndoMark acDoc)
           (vlax-for o (setq acSS (vla-get-ActiveSelectionSet acDoc))
               (setq pat (vla-get-PatternName o))
               (if (cond ((wcmatch (vla-get-PatternName o) "FP_*")
                          (setq pref "x-hatch-pat-Revit-"
                                suf  ""
                                lcol 6
                          )
                         )
                         ((wcmatch (vla-get-PatternName o) "SOLID")
                          (setq pref "x-hatch-pat-"
                                suf  ""
                                lcol 253
                          )
                         )
                         ((wcmatch (vla-get-PatternName o) "DOTS")
                          (setq pref "x-hatch-pat-"
                                suf  ""
                                lcol 253
                          )
                         )
                         ((wcmatch (vla-get-PatternName o) "ANGLE")
                          (setq pref "x-hatch-pat-"
                                suf  ""
                                lcol 254
                          )
                         )
                         ((wcmatch (vla-get-PatternName o) "JIS_*")
                          (setq pref "x-hatch-pat-"
                                suf  ""
                                lcol 4
                          )
                         )
                         ((wcmatch (vla-get-PatternName o) "ACAD_*")
                          (setq pref "x-hatch-pat-"
                                suf  ""
                                lcol 3
                          )
                         )
                         ((wcmatch (vla-get-PatternName o) "ISO_*")
                          (setq pref "x-hatch-pat-"
                                suf  ""
                                lcol 7
                          )
                         )
                         ((wcmatch (vla-get-PatternName o) "AR-*")
                          (setq pref "x-hatch-pat-"
                                suf  ""
                                lcol 5
                          )
                         )
                         )


                   (progn 
           		  (vla-put-ColorMethod oCol acColorMethodByACI)
           		  (vla-put-ColorIndex oCol lcol)
                          (setq pat (strcat pref pat suf))
                          (if (vl-catch-all-error-p
                                  (setq lyr (vl-catch-all-apply 'vla-Item
                                                                (list Lyrs pat)
                                            )
                                  )
                              )
                              (setq lyr (vla-Add Lyrs pat))
                          )
                          (vla-put-TrueColor lyr oCol)
                          (LM:SetLayerTransparency (vla-get-Name lyr) 50)
                          (vla-put-Layer o pat)
                   )                              ; progn
               )                                  ; if
           )                                      ; vlax-for

    ))                                             ; cond
    (*error* nil)
    (princ)
)                                                 ; defun C:test
(vl-load-com)
(princ)

[hanslammerts]

To add to this workaround:

One can easily filter certain hatches using the old "filter" command,

like : Xdata = Revit, object is "Hatch"

Check the video

https://forums.autodesk.com/autodesk/attachments/autodesk/706/906689/1/2017-11-12_22-13-53.mp4