Jump to content

Help to edit LISP


Rooster

Recommended Posts

I came across a LISP that explodes linetypes into their component lines, which I can really make use of occasionally. Only problem is that when the LISP explodes the linetype, it puts everything into layer 0. Is anyone able to help me edit this LISP so that ideally the lines stay in the layers that they are already in, or at least let me choose a different layer for them to go to? Thanks....

 

;;;	EXPLODES LINETYPES INTO INDIVIDUAL COMPONENTS
;;;
;;;    By Dominic Panholzer
;;;
;;;    Modified original TXTEXP.LSP from Express Tools
;;;    Copyright © 1999 by Autodesk, Inc.
;;     LINEXP.LSP modifications by XANADU
;;;
;;;    Your use of this software is governed by the terms and conditions of the
;;;    License Agreement you accepted prior to installation of this software.
;;;    Please note that pursuant to the License Agreement for this software,
;;;    "[c]opying of this computer program or its documentation except as
;;;    permitted by this License is copyright infringement under the laws of
;;;    your country.  If you copy this computer program without permission of
;;;    Autodesk, you are violating the law."
;;;
;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;    UNINTERRUPTED OR ERROR FREE.
;;;
;;;    Use, duplication, or disclosure by the U.S. Government is subject to
;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;;    (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;  ----------------------------------------------------------------
;;;
;;;  External Functions:
;;;
;;;     ACET-ERROR-INIT           --> ACETUTIL.FAS   Intializes bonus error routine
;;;     ACET-ERROR-RESTORE        --> ACETUTIL.FAS   Restores old error routine
;;;     ACET-GEOM-ZOOM-FOR-SELECT --> ACETUTIL.FAS   Zoom boundry to include points given
;;;     ACET-LAYER-LOCKED         --> ACETUTIL.FAS   Checks to see if layer is locked
;;;     ACET-GEOM-PIXEL-UNIT      --> ACETUTIL.FAS   Size of pixel in drawing units
;;;     ACET-GEOM-TEXTBOX         --> ACETUTIL.FAS   Returns the textbox for any text
;;;     ACET-GEOM-MIDPOINT        --> ACETUTIL.FAS   Returns midpoint between two points
;;;     ACET-GEOM-VIEW-POINTS     --> ACETUTIL.FAS   Returns corner points of screen or viewport
;;;     ACET-STR-FORMAT           --> ACETUTIL.ARX   String builder
;;;     ACET-WMFIN                --> ACETUTIL.FAS   Brings in WMF file
;;;

(defun c:linexp (/ grplst getgname blknm FLTR GLST GDICT SS VIEW UPLFT TMPFIL TBX
                  TMPFIL CNT PT1 PT2 ENT TXT TXTYP PTLST ZM LOCKED GNAM vpna vplocked)
 (acet-error-init
       (list
        (list   "cmdecho" 0
                "highlight" 1
                "osmode" 0
                "Mirrtext" 1
                "limcheck" 0
        )
        T
       )
 )

; --------------------- GROUP LIST FUNCTION ----------------------
;   This function will return a list of all the group names in the
;   drawing and their entity names in the form:
;   ((<ename1> . <name1>) ... (<enamex> . <namex>))
; ----------------------------------------------------------------

 (defun acet-txtexp-grplst (/ GRP ITM NAM ENT GLST)

   (setq GRP  (dictsearch (namedobjdict) "ACAD_GROUP"))
   (while (setq ITM (car GRP))       ; While edata item is available
     (if (= (car ITM) 3)             ; if the item is a group name
       (setq NAM (cdr ITM)           ; get the name
             GRP (cdr GRP)           ; shorten the edata
             ITM (car GRP)           ; get the next item
             ENT (cdr ITM)           ; which is the ename
             GRP (cdr GRP)           ; shorten the edata
             GLST                    ; store the ename and name
                 (if GLST
                   (append GLST (list (cons ENT NAM)))
                   (list (cons ENT NAM))
                 )
       )
       (setq GRP (cdr GRP))          ; else shorten the edata
     )
   )
   GLST                              ; return the list
 )

; ------------------- GET GROUP NAME FUNCTION --------------------
;   This function returns a list of all the group names in GLST
;   where ENT is a member. The list has the same form as GLST
; ----------------------------------------------------------------

 (defun acet-txtexp-getgname (ENT GLST / GRP GDATA NAM NLST)
   (if (and GLST (listp GLST))
     (progn
       (foreach GRP GLST
         (setq GDATA (entget (car GRP)))
         (foreach ITM GDATA                   ; step through the edata
           (if (and
                 (= (car ITM) 340)            ; if the item is a entity name
                 (eq (setq NAM (cdr ITM)) ENT) ; and the ename being looked for
               )
             (setq NLST                       ; store the ename and name
                     (if NLST
                       (append NLST (list (cons (car GRP) (cdr GRP))))
                       (list (cons (car GRP) (cdr GRP)))
                     )
             )
           )
         )
       )
     )
   )
   NLST
 )

; ----------------------------------------------------------------
;                          MAIN PROGRAM
; ----------------------------------------------------------------

 (if (and                                                ; Are we in plan view?
       (equal (car (getvar "viewdir")) 0 0.00001)
       (equal (cadr (getvar "viewdir")) 0 0.00001)
       (> (caddr (getvar "viewdir")) 0)
     )

   (progn

     (prompt "\nSelect lines to be EXPLODED: ")

     (Setq FLTR    '((-4 . "<AND")
                       (-4 . "<OR")                      ; filter for mtext and text
                         (0 . "MTEXT")
                         (0 . "TEXT")
                       (-4 . "OR>")
                       (-4 . "<NOT")
                         (102 . "{ACAD_REACTORS")        ; and not leader text
                       (-4 . "NOT>")
                     (-4 . "AND>")
                    )
           GLST     (acet-txtexp-grplst)                             ; Get all the groups in drawing
           GDICT    (if GLST
                      (dictsearch (namedobjdict) "ACAD_GROUP")
                    )
           SS       (ssget);  FLTR)
           CNT      0
     )
     ;; filter out the locked layers
     (if SS
       (setq SS (car (bns_ss_mod SS 1 T)))
     ) ;if

     ;; if we have anything left
     (if SS
       (progn
         (setq CNT 0)                                 ; Reset counter
         (while (setq ENT (ssname SS CNT))            ; step through each object in set

           (and
             GLST                                     ; if groups are present in the drawing
             (setq GNAM (acet-txtexp-getgname ENT GLST))          ; and the text item is in one or more
             (foreach GRP GNAM                        ; step through those groups
               (command "_.-group" "_r"               ; and remove the text item
                 (cdr GRP) ENT ""
               )
             )
           )

           (setq TBX (acet-geom-textbox (entget ENT) 0))   ; get textbox points

           (setq TBX (mapcar '(lambda (x)
                                (trans x 1 0)         ; convert the points to WCS
                              )
                       TBX
                     )
           )

           (setq PTLST (append PTLST TBX))            ; Build list of bounding box
                                                      ; points for text items selected

           (setq CNT (1+ CNT))                        ; get the next text item
         ); while

         (setq PTLST (mapcar '(lambda (x)
                                (trans x 0 1)         ; convert all the points
                              )                       ; to the current ucs
                     PTLST
                   )
         )

         (if (setq ZM (acet-geom-zoom-for-select PTLST))          ; If current view does not contain
           (progn                                     ; all bounding box points
             (setq ZM
               (list
                 (list (- (caar ZM) (acet-geom-pixel-unit))     ; increase zoom area by
                       (- (cadar ZM) (acet-geom-pixel-unit))    ; one pixel width to
                       (caddar ZM)                    ; sure nothing will be lost
                 )
                 (list (+ (caadr ZM) (acet-geom-pixel-unit))
                       (+ (cadadr ZM) (acet-geom-pixel-unit))
                       (caddr (cadr zm))
                 )
               )
             )
             (if (setq vpna (acet-currentviewport-ename))
                 (setq vplocked (acet-viewport-lock-set vpna nil))
             );if
             (command "_.zoom" "_w" (car ZM) (cadr ZM))  ; zoom to include text objects
           )
         )

         (setq VIEW     (acet-geom-view-points)
               TMPFIL   (strcat (getvar "tempprefix") "txtexp.wmf")
               PT1      (acet-geom-midpoint (car view) (cadr view))
               PT2      (list (car PT1) (cadadr VIEW))
         )

         (if (acet-layer-locked (getvar "clayer"))       ; if current layer is locked
           (progn
             (command "_.layer" "_unl" (getvar "clayer") "")  ; unlock it
             (setq LOCKED T)
           )
         )

         (command "_.mirror" SS "" PT1 PT2 "_y"
                  "_.WMFOUT" TMPFIL SS "")

         (if (findfile tmpfil)                           ; Does WMF file exist?
           (progn
             (command "_.ERASE" SS "")                   ; erase the orignal text
             (setq ss (acet-wmfin TMPFIL))               ; insert the WMF file
             (command "_.mirror" ss "" PT1 PT2 "_y")
           ) ;progn
         ) ;if


         (if LOCKED
           (command "_.layer" "_lock" (getvar "clayer") "") ; relock if needed
         ) ;if

         (if ZM (command "_.zoom" "_p"))              ; Restore original view if needed
         (if vplocked 
             (acet-viewport-lock-set vpna T) ;re-lock the viewport if needed.
         );if
         (prompt (acet-str-format "\n%1 object(s) have been exploded to lines."  CNT))
         (prompt "\nThe line objects have been placed on layer 0.")
       )
     )
   )
   (prompt "\nView needs to be in plan (0 0 1).")
 );if equal
 (acet-error-restore)                                  ; Retsore values
 (princ)
)


(princ)

Link to comment
Share on other sites

;;;    Your use of this software is governed by the terms and conditions of the
;;;    License Agreement you accepted prior to installation of this software.
;;;    Please note that pursuant to the License Agreement for this software,
;;;    [color=Red]"[c]opying of this computer program or its documentation except as
;;;    permitted by this License is copyright infringement under the laws of
;;;    your country.  If you copy this computer program without permission of
;;;    Autodesk, you are violating the law."[/color]

 

 

Uhhhhhhhh............

Link to comment
Share on other sites

Easiest solution would be to write another lisp which changes your current working layer "clayer" to whatever layer you want them to be on, then explodes the line, then changes back to what you started with. Very hack solution, though.

Link to comment
Share on other sites

Easiest solution would be to write another lisp which changes your current working layer "clayer" to whatever layer you want them to be on, then explodes the line, then changes back to what you started with. Very hack solution, though.

 

My current working layer at the time of running the LISP is not layer 0 though....

Link to comment
Share on other sites

I dug through it, and whomever originally modified the LISP did almost nothing to it.

 

I did not modify it myself, rather, I dug through it to find the working elements and re-wrote just what was needed.

 

(defun c:linexp2( / file ss)
 (if (setq ss (ssget '((0 . "*LINE"))))
   (progn
     (command "_.WMFOUT" "C:/txtexp.wmf" ss "" "_.ERASE" ss "")
     (acet-wmfin "C:/txtexp.wmf")
     )
   )
 )

Yep, that's it. Something to do with that acet-wmfin function. You'd probably have to edit that to figure out what layer it has to go on.

 

*EDIT* The question has been asked, here:

http://discussion.autodesk.com/forums/thread.jspa?threadID=646386

TL;DR, since it's operating on the selection set and each item could be on a different layer, it can't place them on their original layer unless each item was iterated individually within acet-wmfin.

 

*EDIT EDIT* I'll leave the first because it's quick and clean, but apparently acet-wmfin will work on entities as well as selection sets. I set up a quick loop to replace the layer and set the color to "bylayer." You could probably figure out how to reset the color back to the original as well.

(defun c:linexp2( / file ss entLay)
 (setq file (strcat "C:/" "txtexp.wmf"))
 (setq ss (ssget '((0 . "*LINE"))))
 (if ss (setq ssEnts (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
 (foreach forVar ssEnts
   (setq entLay (cdr (assoc 8 (entget forVar))))
   (command "_.WMFOUT" file forVar "" "_.ERASE" forVar "")
   (setq ss (acet-wmfin file))
   (command "chprop" ss "" "layer" entLay "" "chprop" ss "" "color" "bylayer" "")
   )
 )

Link to comment
Share on other sites

  • 4 weeks later...

Been using this recently, and it works fine on my work PC, but using it at home (same version of AutoCAD etc) I get the following error message and the function then ends:

 

C:\txtexp.wmf: Can't open file

 

 

Anyone able to help?

Link to comment
Share on other sites

Try typing the command "wmfin" and seeing what happens. It should prompt you for a .wmf file. Try and see if you have a txtexp.wmf file in your C:\ drive.

 

Incidentally, I'm glad you got some use out of it. ^^

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...