Author Topic: Linetype Replace  (Read 3900 times)

0 Members and 1 Guest are viewing this topic.

ian50

  • Mosquito
  • Posts: 7
Linetype Replace
« on: April 25, 2010, 04:15:45 PM »
Can any of you kind folk offer me any assistance please, as I'm a complete amateur when it comes to writing lisp.

I'm trying to compile a lisp that will cycle through the drawing entities, including those within deep nested blocks and get the linetype of the entity. If the linetype is non-continuous or is set bylayer but whose layer is also set to a non-continuous linetype I want to do the following:-

a) Compare the linetype to the standard acad.iso types via a wildcard wcmatch search and if different to the standard change the entity linetype or layer linetype to the standard, so if the linetype was '123hiddenxyz' for example, the search would be based upon *hidden* and then change the linetype to 'hidden'

b) Once changed, set the entity linetype scale to a predefined setting

Does anybody have a lisp that does something similar or can point me in the right direction I'd be most grateful.




Andrea

  • Water Moccasin
  • Posts: 2360
Re: Linetype Replace
« Reply #1 on: April 27, 2010, 03:43:18 PM »
Hi,  first....welcome to the swamp ! 

second,..If I understand.. you want to create someting similar as etransmit ?
Keep smile...

ian50

  • Mosquito
  • Posts: 7
Re: Linetype Replace
« Reply #2 on: April 28, 2010, 08:06:23 AM »
Hi Andrea,

I'm not trying to simulate etransmit as such, we regularly receive drawings from third parties such as Architects which we use as xrefs for our drawings. We have to clean them up by typically setting all entities to bylayer and to a greyscale color etc ...

One problem that we tend to find is the linetypes are not defined using the standard acad.lin or acadiso.lin files and may have a similar name, 123hidden for example instead of hidden, or may have a 'Dgn Style ..' reference if the drawings were produced via mircostation. So we need to change the entity non-standard linetypes to standard acad types, which sometimes also involves changing the linetypescale of the entity to get it looking right.

If there are no blocks in the drawing then this is not particularly a problem to go through the drawing and change the entity properties accordingly, however some drawings we receive contain a large amount of deep nested blocks.

I'm therefore looking at trying to change the entity property by lisp rather than exploding or bursting every block and doing a manual edit. So in effect search the drawing for any entity that has a non-continuous linetype (or that is set by layer, with the layer having a non-continuous linetype), get the linetype - compare the linetype to a list, if there is a match, change the entity linetype or layer linetype and set the linetypescale of the entity based on a list.

As my previous post I know a little lisp, but this is way beyond my meager skills!

Ian


Andrea

  • Water Moccasin
  • Posts: 2360
Re: Linetype Replace
« Reply #3 on: April 28, 2010, 11:29:43 AM »
Hi Ian...

Ok there it is...
I've found this routine created in '93 who allow user to change all blocks
color byblock, linetype byblock....

I don't know the owner of this code....but I've modified for your own use.

You will found a list for all linetype you need to change.
Code: [Select]
(setq myLTlist
 '(("ZIGZAG" "HIDDEN")
   ("TRACKS" "CENTER")
   ("NEWLINE" "Continuous")
  )
 )
the first items is your client linetype name and the second the AutoCAD linetype name
Please be sure that all required AutoCAD linetype name is loaded before using it.

Code: [Select]
    ;   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.

    ;*******************************************************************************


;;TEST LINETYPE LIST For IAN50
(setq myLTlist '(("ZIGZAG" "HIDDEN")
                 ("TRACKS" "CENTER")
                 ("NEWLINE" "Continuous")
                 )
      )



;;Created by ???
;;Modified by Andrea Andreetti to allow changing Linetype from Client list
(defun c:FB (/    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


           
;|ORIGINAL CODE
            (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
|;;ORIGINAL CODE



;;MODIFIED CODE by Andrea Andreetti
            (if  (assoc 6 lsubdata)
              (progn
                (if (setq myFoundLT (assoc
                      (setq ltype (strcase (cdr (assoc 6 lsubdata))))
                      myLTlist))
                  (progn
                    (alert (vl-princ-to-string myFoundLT))
                (setq myNewLT (cadr myFoundLT))               
                (setq lsubdata
                       (subst
                         (cons 6 myNewLT)
                         (assoc 6 lsubdata)
                         lsubdata
                       )
                )
                (entmod lsubdata)
                )
                  )             
                 
              ) ;_ end progn
              ;(entmod (append lSubData (list (cons 6 "BYBLOCK"))))
            )
;;;



           
            ;; 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
    ;*******************************************************************************

Keep smile...

ian50

  • Mosquito
  • Posts: 7
Re: Linetype Replace
« Reply #4 on: May 04, 2010, 07:48:43 AM »
Thanks Andrea - very much appreciated!.