Results 1 to 6 of 6

Thread: 2010: Edit the linetype scale of all block sub-entities depending on linetype

  1. #1
    Member
    Join Date
    2012-02
    Location
    Australia
    Posts
    4
    Login to Give a bone
    0

    Default 2010: Edit the linetype scale of all block sub-entities depending on linetype

    Hello Everyone,
    I've been using lisp in autocad for about a 18 months now but lately I've started using batch processing to do a lot of the work for me as time is critical.

    While I've developed a number of lisp routines to use both on the fly and for batch processing my understanding of the code is fairly basic and i just get lost with vla code.
    After having searched the web for 2 weeks for bits of code which would do the things I'm after, i cant put it together properly.
    Not having the freedom to pursue this much longer I've finally decided to ask for help.

    I found a lisp routine which will edit the sub entities of all blocks setting the layer to "0", color to "By Block" and linetype to "By Block".
    This is almost what i want to happen.

    What i need to happen:

    Load linetypes: hidden, phantom, and Centre (this is from a custom *.lin file)

    Change the line type scale of all entities and block sub-entities and according to linetype
    ie: where
    Linetype = "DGN Style 2" Linetype Scale should =10
    Linetype = "DGN Style 3" Linetype Scale should = 10
    Linetype = "DGN Style 4" Linetype Scale should =1
    Linetype = "DGN Style 6" Linetype Scale should =3
    Linetype = "DGN Style 7" Linetype Scale should =1

    Change the line type of all entities, block sub-entities and layers

    Old Linetype: "DGN Style 2", New Linetype:Hidden
    Old Linetype: "DGN Style 3", New Linetype:Hidden
    Old Linetype: "DGN Style 4", New Linetype:Centre
    Old Linetype: "DGN Style 6", New Linetype:Phantom
    Old Linetype: "DGN Style 7", New Linetype:Centre

    then change the Block sub entities properties: layer to "0" and color to "By Block"
    I dont want them set set to "by block" or "by layer" as both the block's and layer's linetype settings are inconsistent.

    The next post contains the code i thought i could adapt, but alas it is beyond me. Thanks to the person who wrote this code in the first place. Sorry i cant remember where i got it from.
    Last edited by roy658480; 2013-06-20 at 05:50 AM. Reason: text formatting not working

  2. #2
    Member
    Join Date
    2012-02
    Location
    Australia
    Posts
    4
    Login to Give a bone
    0

    Default Re: 2010: Edit the linetype scale of all block sub-entities depending on linetype

    Code:
        ;   File Name: FIXBLOCK.LSP
        ;   Description: Puts all of a blocks sub-entities on layer 0 with color and
        ;					  linetype set to BYBLOCK. The block, itself, will remain on
        ;					  its' original layer.
        ;
        ;   Revision:
        ;   3-Dec-2003 YZ
        ;      Changed program to work from a keyword on the command line
        ;*******************************************************************************
    (defun d_FixBlock (/             eBlockSel ; Block selection
                       lInsertData ; Entity data
                       sBlockName ; Block name
                       lBlockData ; Entity data
                       eSubEntity ; Sub-entity name
                       lSubData ; Sub-entity data
                       iCount ; Counter
                      )
    
      ;; Redefine error handler
    
      (setq
        d_#error *error*
        *error*  d_FB_Error
      ) ;_ end setq
    
      ;; Set up environment
    
      (setq #SYSVARS (#SaveSysVars (list "cmdecho")))
    
      (setvar "cmdecho" 0)
      (command "._undo" "_group")
    
      ;; Get block from user and make sure it's an INSERT type
    
      (if (setq eBlockSel (entsel "\nSelect block to change :"))
        (progn
          (if (setq lInsertData (entget (car eBlockSel)))
            (if (= (cdr (assoc 0 lInsertData)) "INSERT")
              (setq sBlockName (cdr (assoc 2 lInsertData)))
              (progn
                (alert "Entity selected is not a block!")
                (exit)
              ) ;_ end progn
            ) ;_ end if
            (progn
              (alert "Invalid Block Selection!")
              (exit)
            ) ;_ end progn
          ) ;_ end if
    
          ;; Get block info from the block table
    
          (setq
            lBlockData (tblsearch "BLOCK" sBlockName)
            eSubEntity (cdr (assoc -2 lBlockData))
          ) ;_ end setq
    
          ;; Make sure block is not an Xref
    
          (if (not (assoc 1 lBlockData))
            (progn
              (princ "\nProcessing block: ")
              (princ sBlockName)
    
              (princ "\nUpdating blocks sub-entities. . .")
    
              ;; Parse through all of the blocks sub-entities
    
              (while eSubEntity
    
                (princ " .")
                (setq lSubData (entget eSubEntity))
    
                ;; Update layer property
    
                (if (assoc 8 lSubData)
                  (progn
                    (setq lSubData
                           (subst
                             (cons 8 "0")
                             (assoc 8 lSubData)
                             lSubData
                           ) ;_ end subst
                    ) ;_ end setq
                    (entmod lSubData)
                  ) ;_ end progn
                ) ;_ end if
    
                ;; Update the linetype property
    
                (if (assoc 6 lSubData)
                  (progn
                    (setq lSubData
                           (subst
                             (cons 6 "BYBLOCK")
                             (assoc 6 lSubData)
                             lSubData
                           ) ;_ end subst
                    ) ;_ end setq
                    (entmod lSubData)
                  ) ;_ end progn
                  (entmod (append lSubData (list (cons 6 "BYBLOCK"))))
                ) ;_ end if
    
                ;; Update the color property
    
                (if (assoc 62 lSubData)
                  (progn
                    (setq lSubData
                           (subst
                             (cons 62 0)
                             (assoc 62 lSubData)
                             lSubData
                           ) ;_ end subst
                    ) ;_ end setq
                    (entmod lSubData)
                  ) ;_ end progn
                  (entmod (append lSubData (list (cons 62 0))))
                ) ;_ end if
    
                (setq eSubEntity (entnext eSubEntity))
        ; get next sub entity
    
              ) ; end while
    
              ;; Update attributes
    
              (idc_FB_UpdAttribs)
    
            ) ; end progn
            (alert "XREF selected. Not updated!")
          ) ; end if
        ) ; end progn
        (alert "Nothing selected.")
      ) ; end if
    
    ;;; Pop error stack and reset environment
    
      (idc_RestoreSysVars)
    
      (princ "\nDone!")
    
      (setq *error* d_#error)
    
      (princ)
    
    )   ; end defun
    
        ;*******************************************************************************
        ; Function to update block attributes
        ;*******************************************************************************
    (defun idc_FB_UpdAttribs ()
    
      ;; Update any attribute definitions
    
      (setq iCount 0)
    
      (princ "\nUpdating attributes. . .")
      (if (setq ssInserts (ssget "x"
                                 (list (cons 0 "INSERT")
                                       (cons 66 1)
                                       (cons 2 sBlockName)
                                 ) ;_ end list
                          ) ;_ end ssget
          ) ;_ end setq
        (repeat (sslength ssInserts)
    
          (setq eBlockName (ssname ssInserts iCount))
    
          (if (setq eSubEntity (entnext eBlockName))
            (setq
              lSubData (entget eSubEntity)
              eSubType (cdr (assoc 0 lSubData))
            ) ;_ end setq
          ) ;_ end if
    
          (while (or (= eSubType "ATTRIB") (= eSubType "SEQEND"))
    
            ;; Update layer property
    
            (if (assoc 8 lSubData)
              (progn
                (setq lSubData
                       (subst
                         (cons 8 "0")
                         (assoc 8 lSubData)
                         lSubData
                       ) ;_ end subst
                ) ;_ end setq
                (entmod lSubData)
              ) ;_ end progn
            ) ;_ end if
    
            ;; Update the linetype property
    
            (if (assoc 6 lSubData)
              (progn
                (setq lSubData
                       (subst
                         (cons 6 "BYBLOCK")
                         (assoc 6 lSubData)
                         lSubData
                       ) ;_ end subst
                ) ;_ end setq
                (entmod lSubData)
              ) ;_ end progn
              (entmod (append lSubData (list (cons 6 "BYBLOCK"))))
            ) ;_ end if
    
            ;; Update the color property
    
            (if (assoc 62 lSubData)
              (progn
                (setq lSubData
                       (subst
                         (cons 62 0)
                         (assoc 62 lSubData)
                         lSubData
                       ) ;_ end subst
                ) ;_ end setq
                (entmod lSubData)
              ) ;_ end progn
              (entmod (append lSubData (list (cons 62 0))))
            ) ;_ end if
    
            (if (setq eSubEntity (entnext eSubEntity))
              (setq
                lSubData (entget eSubEntity)
                eSubType (cdr (assoc 0 lSubData))
              ) ;_ end setq
              (setq eSubType nil)
            ) ;_ end if
    
          ) ; end while
    
          (setq iCount (1+ iCount))
    
        ) ; end repeat
    
      ) ; end if
      (command "regen")
    )   ; end defun
    
        ;*******************************************************************************
        ; Function to save a list of system variables
        ;*******************************************************************************
    (defun #SaveSysVars (lVarList / sSystemVar)
      (mapcar
        '(lambda (sSystemVar)
           (setq lSystemVars
                  (append lSystemVars
                          (list (list sSystemVar (getvar sSystemVar)))
                  ) ;_ end append
           ) ;_ end setq
         ) ;_ end lambda
        lVarList
      ) ;_ end mapcar
    
      lSystemVars
    
    ) ;_ end defun
        ;*******************************************************************************
        ; Function to restore a list of system variables
        ;*******************************************************************************
    (defun idc_RestoreSysVars ()
      (mapcar
        '(lambda (sSystemVar)
           (setvar (car sSystemVar) (cadr sSystemVar))
         ) ;_ end lambda
        #SYSVARS
      ) ;_ end mapcar
    ) ;_ end defun
        ;*******************************************************************************
        ; Error Handler
        ;*******************************************************************************
    (defun d_FB_Error (msg)
    
      (princ "\nError occurred in the Fix Block routine...")
      (princ "\nError: ")
      (princ msg)
    
      (setq *error* d_#error)
      (if *error*
        (*error* msg)
      ) ;_ end if
    
      (command)
    
      (if (/= msg "quit / exit abort")
        (progn
          (command "._undo" "_end")
          (command "._u")
        ) ;_ end progn
      ) ;_ end if
    
      (idc_RestoreSysVars)
    
      (princ)
    
    ) ;_ end defun
        ;*******************************************************************************
    
    (defun C:FIXBLOCK () (d_FixBlock))
    (princ)

  3. #3
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL USA
    Posts
    3,658
    Login to Give a bone
    0

    Default Re: 2010: Edit the linetype scale of all block sub-entities depending on linetype

    Don't have those linetypes, so untested:
    Code:
     (vl-load-com)
    (defun C:FIXBLKSroy (/ *ERROR* SSET intCount ENAM ELST BNAM FLST FIX1)
      (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
      (vla-startundomark thisdrawing)
    
    
     (defun *ERROR* (err) ; define local handler
       (vl-cmdf "undo" "Mark")
       (princ "\n\n")
       (princ)
     );  "" is the same message you get when exiting an AutoCAD command.
    
      (defun FIX1 (BNAM / BENAM BONAM)
        (if (not (member BNAM FLST))
      	(progn
      	  (setq FLST  (cons BNAM FLST)
      	 	BENAM (tblobjname "block" BNAM)
      	  )
    	  (while (setq BENAM (entnext BENAM))
     	    (if (= (cdr (assoc 0 (entget BENAM))) "INSERT")
    	      (fix1 (cdr (assoc 2 (entget BENAM))))
    	      (progn
    	        (setq BONAM(vlax-ename->vla-object BENAM))
    	        (cond
    	          ((= "DGN Style 2"(vlax-get-property BONAM 'Linetype))
    ;		      (vla-put-LinetypeScale BONAM 10)
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 10))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Hidden"))
    	          )
    	          ((= "DGN Style 3"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 10))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Hidden"))
    	          )
    	          ((= "DGN Style 4"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 1))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Centre"))
    	          )
    	          ((= "DGN Style 6"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 3))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Phantom"))
    	          )
    	          ((= "DGN Style 7"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 1))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Centre"))
    	          )
    	          (T
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Byblock"))
    	          )
    	        )
                    (vl-catch-all-apply 'vla-put-layer (list BONAM "0"))
                    (vl-catch-all-apply 'vla-put-color (list BONAM 0))
    	      )
    	    )
    	  )
            )
        )
      )
    
      (setq SSET (ssget (list (cons 0 "INSERT"))))
      (repeat (setq intCount (sslength SSET))
        (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  ELST (entget ENAM)
     	  BNAM (cdr (assoc 2 ELST))
     	  FLST nil
        )
        (fix1 BNAM)
      )
      (vl-cmdf "regen")
      (vla-endundomark thisdrawing)
      (princ)
    )

  4. #4
    Member
    Join Date
    2012-02
    Location
    Australia
    Posts
    4
    Login to Give a bone
    0

    Default Re: 2010: Edit the linetype scale of all block sub-entities depending on linetype

    Thanks Tom, this code works fantastically for the block sub entities and it'll help me understand the code a bit more too.

    Is there a way to use this code to
    A: also include entities not contained within in blocks
    B: change the layers linetype setting
    C: automatically select all blocks in the file when called instead of prompting the user to select block

    If you need it, Attached is my test file which has all linetypes loaded, in each scenario where the change is required.
    After the linetype change you will probably need to set the global linetype scale (lts) to 20 to see the results. (note: this it not required in this code)
    Line type test.dwg
    Last edited by roy658480; 2013-06-21 at 12:33 AM. Reason: additional note

  5. #5
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL USA
    Posts
    3,658
    Login to Give a bone
    0

    Default Re: 2010: Edit the linetype scale of all block sub-entities depending on linetype

    This should take care of A & C:
    Code:
     (vl-load-com)
    (defun C:FIXBLKSroy (/ *ERROR* SSET intCount ENAM EOBJ ELST BNAM FLST FIX1)
      (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
      (vla-startundomark thisdrawing)
    
    
     (defun *ERROR* (err) ; define local handler
       (vl-cmdf "undo" "Mark")
       (princ "\n\n")
       (princ)
     );  "" is the same message you get when exiting an AutoCAD command.
    
      (defun FIX1 (BNAM / BENAM BONAM)
        (if (not (member BNAM FLST))
      	(progn
      	  (setq FLST  (cons BNAM FLST)
      	 	BENAM (tblobjname "block" BNAM)
      	  )
    	  (while (setq BENAM (entnext BENAM))
     	    (if (= (cdr (assoc 0 (entget BENAM))) "INSERT")
    	      (fix1 (cdr (assoc 2 (entget BENAM))))
    	      (progn
    	        (setq BONAM(vlax-ename->vla-object BENAM))
    	        (cond
    	          ((= "DGN Style 2"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 10))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Hidden"))
    	          )
    	          ((= "DGN Style 3"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 10))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Hidden"))
    	          )
    	          ((= "DGN Style 4"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 1))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Centre"))
    	          )
    	          ((= "DGN Style 6"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 3))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Phantom"))
    	          )
    	          ((= "DGN Style 7"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 1))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Centre"))
    	          )
    	          (T
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Byblock"))
    	          )
    	        )
                    (vl-catch-all-apply 'vla-put-layer (list BONAM "0"))
                    (vl-catch-all-apply 'vla-put-color (list BONAM 0))
    	      )
    	    )
    	  )
            )
        )
      )
      (setq SSET (ssget "X" (list (cons 6 "DGN Style 2,DGN Style 3"))))
      (repeat (setq intCount (sslength SSET))
        (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  EOBJ (vlax-ename->vla-object ENAM)
        )
        (vla-put-LinetypeScale EOBJ 10)
        (vla-put-Linetype EOBJ "Hidden")
      )
      (setq SSET (ssget "X" (list (cons 6 "DGN Style 4,DGN Style 7"))))
      (repeat (setq intCount (sslength SSET))
        (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  EOBJ (vlax-ename->vla-object ENAM)
        )
        (vla-put-LinetypeScale EOBJ 1)
        (vla-put-Linetype EOBJ "Hidden")
      )
      (setq SSET (ssget "X" (list (cons 6 "DGN Style 6"))))
      (repeat (setq intCount (sslength SSET))
        (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  EOBJ (vlax-ename->vla-object ENAM)
        )
       (vla-put-LinetypeScale EOBJ 3)
       (vla-put-Linetype EOBJ "Centre")
      )
      (setq SSET (ssget "X" (list (cons 0 "INSERT")))) ; every block in drawing
    ;  (setq SSET (ssget (list (cons 0 "INSERT")))) ; pick blocks
      (repeat (setq intCount (sslength SSET))
        (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  ELST (entget ENAM)
     	  BNAM (cdr (assoc 2 ELST))
     	  FLST nil
        )
        (fix1 BNAM)
      )
      (vl-cmdf "regen")
      (vla-endundomark thisdrawing)
      (princ)
    )
    Let me know how that works while I look at the layers table.

  6. #6
    Member
    Join Date
    2012-02
    Location
    Australia
    Posts
    4
    Login to Give a bone
    0

    Default Re: 2010: Edit the linetype scale of all block sub-entities depending on linetype

    Hi Tom i did a little bit of tweaking and the code seems to work well so far, thanks for your help.

    I have added code to change the layers that i know of but would still like to know how to select and edit the layer properties based on their assigned properties (linetypes, etc).
    Here is the code I'm currently using

    Code:
    (vl-load-com)
    (defun C:fb (/ *ERROR* SSET intCount ENAM EOBJ ELST BNAM FLST FIX1)
      (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
      (vla-startundomark thisdrawing)
      
    ;Roy-Load Linetypes
    (if (tblsearch "LTYPE" "centre")
        (command "-linetype" "l" "centre" "C:/Program Files/AutoCAD 2010/Support/Linetypes/Centre.lin" "YES" "")
        (command "-linetype" "l" "centre" "C:/Program Files/AutoCAD 2010/Support/Linetypes/Centre.lin" "")
    )(princ)
    (if (tblsearch "LTYPE" "dot2")
        (command "-linetype" "l" "dot2" "C:/Documents and Settings/jonesr/Application Data/Autodesk/AutoCAD 2010/R18.0/enu/Support/acad.lin" "YES" "")
        (command "-linetype" "l" "dot2" "C:/Documents and Settings/jonesr/Application Data/Autodesk/AutoCAD 2010/R18.0/enu/Support/acad.lin" "")
    )(princ)
    (if (tblsearch "LTYPE" "HIDDEN")
        (command "-linetype" "l" "HIDDEN" "C:/Documents and Settings/jonesr/Application Data/Autodesk/AutoCAD 2010/R18.0/enu/Support/acad.lin" "YES" "")
        (command "-linetype" "l" "HIDDEN" "C:/Documents and Settings/jonesr/Application Data/Autodesk/AutoCAD 2010/R18.0/enu/Support/acad.lin" "")
    )(princ)
    (if (tblsearch "LTYPE" "PHANTOM")
        (command "-linetype" "l" "PHANTOM" "C:/Documents and Settings/jonesr/Application Data/Autodesk/AutoCAD 2010/R18.0/enu/Support/acad.lin" "YES" "")
        (command "-linetype" "l" "PHANTOM" "C:/Documents and Settings/jonesr/Application Data/Autodesk/AutoCAD 2010/R18.0/enu/Support/acad.lin" "")
    )(princ)
    (prompt "\n\n")
    (prompt "\nLINETYPES LOADED")
    (command "resume")
    (princ)
    ;=================
      
     (defun *ERROR* (err) ; define local handler
       (vl-cmdf "undo" "Mark")
       (princ "\n\n")
       (princ)
     );  "" is the same message you get when exiting an AutoCAD command.
    
      (defun FIX1 (BNAM / BENAM BONAM)
        (if (not (member BNAM FLST))
      	(progn
      	  (setq FLST  (cons BNAM FLST)
      	 	BENAM (tblobjname "block" BNAM)
      	  )
    	  (while (setq BENAM (entnext BENAM))
     	    (if (= (cdr (assoc 0 (entget BENAM))) "INSERT")
    	      (fix1 (cdr (assoc 2 (entget BENAM))))
    	      (progn
    	        (setq BONAM(vlax-ename->vla-object BENAM))
    	        (cond
    		  ; roys code
    		  ((= "DGN Style 1"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 5))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Dot2"))
    	          )
    	  	  ; roys code
    	          ((= "DGN Style 2"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 10))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Hidden"))
    		  )
    	          ((= "DGN Style 3"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 10))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Hidden"))
    		  )
    	          ((= "DGN Style 4"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 1))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Centre"))
    		  )
    	          ((= "DGN Style 6"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 3))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Phantom"))
    		  )
    	          ((= "DGN Style 7"(vlax-get-property BONAM 'Linetype))
    		      (vl-catch-all-apply 'vla-put-LinetypeScale (list BONAM 1))
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Centre"))
    		  )
    	          (T
    		      (vl-catch-all-apply 'vla-put-linetype (list BONAM "Byblock"))
    	          )
    	        )
                    (vl-catch-all-apply 'vla-put-layer (list BONAM "0"))
                    (vl-catch-all-apply 'vla-put-color (list BONAM 0))
    		;Roy-Set Linetype Generation
    		(vl-catch-all-apply 'vla-put-linetypegeneration (list BONAM 0))
    		;===========================
    	      )
    	    )
    	  )
            )
        )
      )
    
    ;ALL OBJECTS NOT IN BLOCKS
    (PROMPT "\n         PROCESSING ALL OBJECTS NOT IN BLOCKS")
    (if (setq SSET (ssget "X" (list (cons 6 "DGN Style 2,DGN Style 3"))))
        (repeat (setq intCount (sslength SSET))
          (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  EOBJ (vlax-ename->vla-object ENAM)
          )
          (vla-put-LinetypeScale EOBJ 10)
          (vla-put-Linetype EOBJ "Hidden")
        )
        (prompt "\n	        No objects outside of blocks with a linetype of DGN Style 2,DGN Style 3")
    )
      
    (if (setq SSET (ssget "X" (list (cons 6 "DGN Style 4,DGN Style 7"))))
        (repeat (setq intCount (sslength SSET))
          (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  EOBJ (vlax-ename->vla-object ENAM)
          )
          (vla-put-LinetypeScale EOBJ 1)
          (vla-put-Linetype EOBJ "CENTRE")
        )
        (prompt "\n        No objects outside of blocks with a linetype of DGN Style 4,DGN Style 7")
    )
      
    (if (setq SSET (ssget "X" (list (cons 6 "DGN Style 6"))))
        (repeat (setq intCount (sslength SSET))
          (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  EOBJ (vlax-ename->vla-object ENAM)
    	        )
          (vla-put-LinetypeScale EOBJ 3)
          (vla-put-Linetype EOBJ "PHANTOM")
        )
        (prompt "\n        No objects outside of blocks with a linetype of DGN Style 6")
    )
    
    ;Roy-Set Linetype Generation  
    (if (setq SSET (ssget "x" (list (cons 0 "LWpolyline"))))
        (repeat (setq intCount (sslength SSET))
          (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  EOBJ (vlax-ename->vla-object ENAM)
    	        )
          (vl-catch-all-apply 'vla-put-linetypegeneration (list EOBJ 0))
        )
        (prompt "\n        No objects outside of blocks that are Polylines")
    )
    ;===================
      
    ;Roy-Set Color Correction
    (if (setq SSET (ssget "x" (list (cons 62 254))))
        (repeat (setq intCount (sslength SSET))
          (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  EOBJ (vlax-ename->vla-object ENAM)
    	        )
          (vl-catch-all-apply 'vla-put-color (list EOBJ 9))
        )
        (prompt "\n        No objects outside of blocks that are Polylines")
    )
    ;===================
      
    ;Roy-Set properties of known Layers  
    (command "-layer" "l" "centre" "centre,1000-Excavation Centre Lines" "")
    (princ)
    (command "-layer" "l" "Phantom" "phantom,Handrail SingleLine" "")
    (princ)
    (command "-layer" "l" "hidden" "hidden,Concrete-Hidden1,Steel_BeamHidden,Steel_ColumnHidden" "")
    (princ)
    (command "-layer" "c" "9" "phantom,hatch,hidden" "")
    (princ)
    (command ^C^C)
    ;===================
    
    ;Roy-Set properties of known Layer Objects
    (if (setq SSET (ssget "x" (list (cons 8 "phantom,Handrail SingleLine"))))
        (repeat (setq intCount (sslength SSET))
          (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  EOBJ (vlax-ename->vla-object ENAM)
    	        )
          (vla-put-LinetypeScale EOBJ 3)
          (vla-put-Linetype EOBJ "bylayer")
        )
        (prompt "\n        No objects on layers named phantom,Handrail SingleLine")
    )
    (if (setq SSET (ssget "x" (list (cons 8 "hidden,Concrete-Hidden1,Steel_BeamHidden,Steel_ColumnHidden"))))
        (repeat (setq intCount (sslength SSET))
          (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  EOBJ (vlax-ename->vla-object ENAM)
    	        )
          (vla-put-LinetypeScale EOBJ 10)
          (vla-put-Linetype EOBJ "ByLayer")
        )
        (prompt "\n        No objects on layers named hidden,Concrete-Hidden1,Steel_BeamHidden,Steel_ColumnHidden")
    )
    (if (setq SSET (ssget "x" (list (cons 8 "centre,1000-Excavation Centre Lines"))))
        (repeat (setq intCount (sslength SSET))
          (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  EOBJ (vlax-ename->vla-object ENAM)
    	        )
          (vla-put-LinetypeScale EOBJ 1)
          (vla-put-Linetype EOBJ "ByLayer")
        )
        (prompt "\n        No objects on layers named centre,1000-Excavation Centre Lines")
    )    
    ;===================
      
     
      (setq SSET (ssget "X" (list (cons 0 "INSERT")))) ; every block in drawing
      ;(setq SSET (ssget (list (cons 0 "INSERT")))) ; pick blocks
      (repeat (setq intCount (sslength SSET))
        (setq intCount     (1- intCount)
              ENAM (ssname SSET intCOunt)
     	  ELST (entget ENAM)
     	  BNAM (cdr (assoc 2 ELST))
     	  FLST nil
        )
        (fix1 BNAM)
        
      )
      (vl-cmdf "regen")
      (vla-endundomark thisdrawing)
      (princ)
      (command "resume")
      )

Similar Threads

  1. Set all entities / objects linetype scale to 1
    By Cad4men in forum AutoCAD General
    Replies: 8
    Last Post: 2012-08-28, 02:46 AM
  2. Edit Linetype
    By nextvkin in forum AutoCAD General
    Replies: 18
    Last Post: 2011-10-14, 01:04 PM
  3. Linetype Scale (LTS)
    By Viswaprakash in forum CAD Standards
    Replies: 8
    Last Post: 2009-04-30, 07:16 PM
  4. Dynamic Block Linetype Scale
    By scoutmaster in forum Dynamic Blocks - Technical
    Replies: 3
    Last Post: 2008-12-22, 09:00 PM
  5. Linetype scale
    By susanima in forum AutoCAD LT - General
    Replies: 1
    Last Post: 2005-08-17, 11:33 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •