Visual LISP, AutoLISP and General Customization

Reply
Active Contributor
haynesc87
Posts: 43
Registered: ‎02-05-2011
Message 1 of 8 (528 Views)

! Script Help Please - Linetype Replace

528 Views, 7 Replies
01-28-2013 10:14 AM

Hello all

 

The Situation is as follows :

 

I wish to have a script that can be run on 1000+ drawings to do the following :

 

Load a New Defined Linetype .... "NewLineType000"

 

Select all layers that = NOT Continuous & = Colour 8 > Replace Linetype with "NewLineType000"

 

Can anyone help me out please, many thanks in advance

 

Chris

Mentor
diagodose2009
Posts: 258
Registered: ‎12-04-2009
Message 2 of 8 (510 Views)

Re: ! Script Help Please - Linetype Replace

01-28-2013 01:15 PM in reply to: haynesc87

Hi............

I need the testing drawing (.dwg) file.......

you save the fiel.dwg  on "autocad2002.version"

please, you attach here (testing file.dwg)

Regards..

Active Contributor
haynesc87
Posts: 43
Registered: ‎02-05-2011
Message 3 of 8 (492 Views)

Re: ! Script Help Please - Linetype Replace

01-29-2013 02:25 AM in reply to: haynesc87

I am working on Autocad Architecture 2010

*Expert Elite*
hmsilva
Posts: 2,639
Registered: ‎12-17-2004
Message 4 of 8 (469 Views)

Re: ! Script Help Please - Linetype Replace

01-29-2013 03:34 PM in reply to: haynesc87

haynesc87 wrote

: ...

I wish to have a script that can be run on 1000+ drawings to do the following : Load a New Defined Linetype ..."NewLineType000" Select all layers that = NOT Continuous & = Colour 8 > Replace Linetype with "NewLineType000"

...

 

Chris,

save the following code a in a 'support' folder with the name of LayLt.lsp change the linetype name if necessary, and the .lin file name where the linetype is defined, in this case was in ACAD.lin

 

  (if
    (not (tblsearch "ltype" "NewLineType000"))
     (command "_linetype" "load" "NewLineType000" "ACAD" "")
  )
  (vlax-for layer (vla-get-layers
		    (vla-get-activedocument (vlax-get-acad-object))
		  )
    (if
      (not (and
	     (= 8 (vla-get-color layer))
	     (= (vla-get-linetype layer) "Continuous")
	   )
      )
       (vla-put-linetype layer "NewLineType000")
    )
  )
  (princ)

 

the following code was posted by EC-CAD, some time ago, and I changed it to run the above code.
the code will process the DWGs in a entire directory, save it as BatchDwg10.lsp, load it ad type
BATCH-DWG to run it

 

;; BatchDwg10.lsp by EC-CAD
;; To Batch Drawings..
;;
;; Note: replace the Path/filename below to call up your Lisp
;;       to process the drawings the way you want.
;;

;; Make sure your lisp program is in a 'support' folder ..
(setq my_lisp_file "LayLt"); Place your lisp here !

;; Load Supporting Functions
;; Old Version of 'BrowseForFolder' by: Tony Tanzillo 
(defun BrowseForFolder ( Message / sh folder parentfolder folderobject result) 
 (vl-load-com) 
  (setq sh 
   (vla-getInterfaceObject 
     (vlax-get-acad-object) 
       "Shell.Application" 
     ) 
   ) 


   (setq folder 
      (vlax-invoke-method 
          sh 
          'BrowseForFolder 
          0 
          Message 
          0 
       ) 
   ) 
   (vlax-release-object sh) 


    (if folder 
      (progn 
         (setq parentfolder 
           (vlax-get-property folder 'ParentFolder) 
         ) 
        (setq FolderObject 
           (vlax-invoke-method 
              ParentFolder 
               'ParseName 
              (vlax-get-property Folder 'Title) 
           ) 
        ) 
       (setq result 
          (vlax-get-property FolderObject 'Path) 
       ) 
       (mapcar 'vlax-release-object 
         (list folder parentfolder folderobject) 
       ) 
     (if (/= (substr result (strlen result)) "\\")
       (setq result (strcat result "\\"))
       result
     )
   ) 
 ) 
); defun

(defun C:BATCH-DWG ()
  (if (setq DirPath (BrowseForFolder "Select directory to batch drawings."))
   (progn
    (setq DwgList (vl-directory-files DirPath "*.dwg" 1))
    (setq ScrFile (strcat DirPath "batchme.scr"))
    (setq Ofil (open ScrFile "W"))
     (write-line "SDI 0" Ofil); Force Multi-Document mode
     (write-line (strcat "(setvar " (chr 34) "FILEDIA" (chr 34) " 0)") Ofil)
     (foreach Dwg DwgList
        (setq FullPath (strcat DirPath Dwg))
        (write-line (strcat "_.open " (chr 34) FullPath (chr 34)) Ofil)
        (write-line (strcat "(load " (chr 34) my_lisp_file (chr 34) ")") Ofil)
        (write-line (strcat "(setvar " (chr 34) "FILEDIA" (chr 34) " 1)") Ofil)
        (write-line "_.qsave" Ofil)
        (write-line "_.close" Ofil)
     ); foreach
     (write-line (strcat "(setvar " (chr 34) "FILEDIA" (chr 34) " 1)") Ofil)
     (close Ofil)
     (command "_.script" ScrFile)
   ); progn
  ); if
 (princ)
); function
 (prompt "\nType BATCH-DWG to begin the batch process:")
 (princ)

 

hope that helps

 

Henrique

Active Contributor
haynesc87
Posts: 43
Registered: ‎02-05-2011
Message 5 of 8 (458 Views)

Re: ! Script Help Please - Linetype Replace

01-30-2013 08:59 AM in reply to: hmsilva

Hi Thanks for this

 

I tested it and the following is the outcome ....

 

01 - Layers which = Colour 8 & NOT Continuous where changed to "NewLinetype"

 

02 - Layers which = Colour NOT 8 & Continuous where changed to "NewLinetype"

 

03 - Layers which = Colour NOT 8 & NOT Continuous where changed to "NewLinetype"

 

... only outcome 01 is correct

 

Can you edit the script for me - its almost working

 

Thanks

*Expert Elite*
hmsilva
Posts: 2,639
Registered: ‎12-17-2004
Message 6 of 8 (453 Views)

Re: ! Script Help Please - Linetype Replace

01-30-2013 09:06 AM in reply to: haynesc87

try

 

 (if
    (not (tblsearch "ltype" "NewLineType000"))
     (command "_linetype" "load" "NewLineType000" "ACAD" "")
  )
  (vlax-for layer (vla-get-layers
		    (vla-get-activedocument (vlax-get-acad-object))
		  )
    (if
     (and
	     (= 8 (vla-get-color layer))
	     (/= (vla-get-linetype layer) "Continuous")   
      )
       (vla-put-linetype layer "NewLineType000")
    )
  )
  (princ)

 Henrique

Active Contributor
haynesc87
Posts: 43
Registered: ‎02-05-2011
Message 7 of 8 (451 Views)

Re: ! Script Help Please - Linetype Replace

01-30-2013 09:07 AM in reply to: hmsilva

Life Saver

 

Thanks very much Henrique

*Expert Elite*
hmsilva
Posts: 2,639
Registered: ‎12-17-2004
Message 8 of 8 (449 Views)

Re: ! Script Help Please - Linetype Replace

01-30-2013 09:09 AM in reply to: haynesc87

You're welcome, 


Henrique

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community