Results 1 to 6 of 6

Thread: Need some help with routine please

  1. #1
    Member
    Join Date
    2007-09
    Posts
    10
    Login to Give a bone
    0

    Default Need some help with routine please

    Hi

    I have found a routine for cleaning up xref’s which I am modifying and adding to to suit my needs.

    I have come up against a few problems that I would like some help with please.

    1. I would like the burst command to repeat until all blocks inc. nested blocks are burst. I have used the repeat but this is a little clumsy and requires the user to press enter if there aren’t blocks nested 3 times (if you get what I mean).

    2. I would like to purge the drawing once all the layers have been sorted but I can’t figure out how to add the purge command to the end of the routine.

    Many thanks.

    Grayham

    Code:
    ;COMMANDS TO CLEAN XREFS
    (defun C:XCL (/ ss1 ss2 la layer dest-layer)
    
    
    (command "undo" "begin")
    (setvar "cmdecho" 0)
    
    
    
    (command "-xref" "d" "*")
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Burst all begin
    
    (repeat 3(setq ssall (ssget "all"))
    (sssetfirst nil ssall) 
    (c:burst)
    ) ;; End repeat
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Burst all end
    
    
    
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Overkill begin
    
    (setq SelectionSet (ssget "X"))
    
    Then run overkill.
    
    (load "overkillsup")
    
    (acet-overkill2 (list SelectionSet 0.000001 nil T nil nil))
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Overkill end
    
    
    (command "layon") ; Turns on all layers
    (c:layers-erase) ; Delets frozen layers
    
    
    (command "undo" "begin")
    (setvar "cmdecho" 0)
    
    
    
    ;first purges drawing
    
    (repeat 5 (command "PURGE" "ALL" "*" "N"))
    
    (command "-layer" "set" "0" "")
    
    ;creates new xref layers
    
    (command ".-layer" "new" "X-WALLS" "COLOR" "253"
    "X-WALLS" "new" "X-TEXT" "COLOR" "252"
    "X-TEXT" "new" "X-CEILING" "COLOR" "252"
    "X-CEILING" "new" "X-GRID" "COLOR" "14"
    "X-GRID" "new" "X-FURN" "COLOR" "252"
    "X-FURN" "new" "X-HATCH" "COLOR" "252"
    "X-HATCH" "new" "X-SAN" "COLOR" "252"
    "X-SAN" "new" "X-DIMS" "COLOR" "252"
    "X-DIMS" "new" "X-USER1" "COLOR" "252"
    "X-USER1" "new" "X-USER2" "COLOR" "252"
    "X-USER2" "new" "X-USER3" "COLOR" "252"
    "X-USER3" "new" "X-USER4" "COLOR" "252"
    "X-USER4" "new" "X-USER5" "COLOR" "252" "X-USER5"
    "")
    
    (command ".-layer" "freeze" "X-WALLS" "freeze"
    "X-TEXT" "freeze" "X-GRID" "freeze"
    "X-FURN" "freeze" "X-HATCH" "freeze"
    "X-SAN" "freeze" "X-DIMS" "freeze"
    "X-USER1" "freeze" "X-USER2" "freeze"
    "X-USER3" "freeze" "X-USER4" "freeze"
    "X-USER5" ""
    )
    
    
    ;------------------------------------------------------------------error handler
    error
    handler
    (setq older *error*)
    
    (defun myerr (msg)
    (princ "\n\n **** Cancelled - Variables Reset ok ****")
    (princ)
    (setq *error* older)
    (setvar "cmdecho" 1)
    (setq blockname nil
    e1 nil
    ed nil
    ss1 nil
    ss2 nil
    la nil
    layer nil
    dest-layer
    nil
    older nil
    )
    (command "-layer" "on" "*" "")
    (command "-layer" "thaw" "*" "")
    (command "undo" "end")
    
    (princ"\nRoutine exited")(princ)
    )
    (setq *error* myerr)
    
    ;--------------------------------------------------------------------
    
    (while (= 1 1)
    
    ;asks user for object and isolates that layer
    
    (setq ss1 nil)
    (setq ss1 (entsel "\nSelect object or escape: "))
    (while (= ss1 nil)
    (setq ss1 (entsel "\nYou missed, select again or escape: "))
    ) ;while
    (setq la (CDR (Assoc 8 (entget (car ss1)))))
    
    (command ".-layer" "s" la "off" "*" "n" "")
    (setq ss2
    (ssget
    "X"
    (list (cons 8 (getvar "clayer")) (cons 410 (getvar "CTAB")))
    )
    )
    
    ;asks user for destination layer#
    (initget "C D F G H S T W U1 U2 U3 U4 U5")
    (setq dest-layer
    (getkword
    "\nDestination layer; x-(C)eiling, x-(D)ims, x-(F)urn, x-(G)rid, x-(H)atch, x-(S)an, x-(T)ext, x-(W)alls, x-(U1)ser1, x-(U2)ser2, x-(U3)ser3, x-(U4)ser4, x-(U5)ser5: "
    )
    )
    
    (if (= dest-layer "C")
    (setq layer "X-CEILING")
    ) ;end if
    
    (if (= dest-layer "D")
    (setq layer "X-DIMS")
    ) ;end if
    
    (if (= dest-layer "F")
    (setq layer "X-FURN")
    ) ;end if
    
    (if (= dest-layer "G")
    (setq layer "X-GRID")
    ) ;end if
    
    (if (= dest-layer "H")
    (setq layer "X-HATCH")
    ) ;end if
    
    (if (= dest-layer "S")
    (setq layer "X-SAN")
    ) ;end if
    
    (if (= dest-layer "T")
    (setq layer "X-TEXT")
    ) ;end if
    
    (if (= dest-layer "W")
    (setq layer "X-WALLS")
    ) ;end if
    
    (if (= dest-layer "U1")
    (setq layer "X-USER1")
    ) ;end if
    
    (if (= dest-layer "U2")
    (setq layer "X-USER2")
    ) ;end if
    
    (if (= dest-layer "U3")
    (setq layer "X-USER3")
    ) ;end if
    
    (if (= dest-layer "U4")
    (setq layer "X-USER4")
    ) ;end if
    
    (if (= dest-layer "U5")
    (setq layer "X-USER5")
    ) ;end if
    
    ;moves selection set ss2 to destination layer
    
    (command "chprop" ss2 "" "color" "bylayer" "lweight" "bylayer" "")
    (command "chprop" ss2 "" "layer" layer "")
    
    ;turns all layers back on for next selection
    
    (command "-layer" "on" "*" "")
    
    
    );while
    (setvar "cmdecho" 1)
    (command "undo" "end")
    
    
    
    
    
    ) ;end defun
    Last edited by RobertB; 2007-09-20 at 02:40 PM. Reason: Added code tags

  2. #2
    Administrator Opie's Avatar
    Join Date
    2002-01
    Location
    jUSt Here (a lot)
    Posts
    8,518
    Login to Give a bone
    0

    Default Re: Need some help with routine please

    Sample for your burst section with an example of the purge command.
    Code:
      (while (setq SelectionSet (ssget "X" '((0 . "INSERT"))))
        (sssetfirst nil SelectionSet)
        (c:burst)
        (command "-purge" "B" "*" "N")
      )
    The purge command is not necessary for this snippet to work, but it purges the blocks after they have been burst.
    If you have a technical question, please find the appropriate forum and ask it there.
    You will get a quicker response from your fellow AUGI members than if you sent it to me via a PM or email.
    jUSt

  3. #3
    The Silent Type RobertB's Avatar
    Join Date
    2000-01
    Location
    Seattle WA USA
    Posts
    5,859
    Login to Give a bone
    0

    Default Re: Need some help with routine please

    Might need to be careful with that loop. What happens if you run into a block that cannot be exploded?
    R. Robert Bell
    Design Technology Manager
    Stantec
    Opinions expressed are mine alone and do not reflect the views of Stantec.

  4. #4
    Administrator Opie's Avatar
    Join Date
    2002-01
    Location
    jUSt Here (a lot)
    Posts
    8,518
    Login to Give a bone
    0

    Default Re: Need some help with routine please

    That would be a problem and additional code would need to be assembled to handle it.
    If you have a technical question, please find the appropriate forum and ask it there.
    You will get a quicker response from your fellow AUGI members than if you sent it to me via a PM or email.
    jUSt

  5. #5
    Member
    Join Date
    2007-09
    Posts
    10
    Login to Give a bone
    0

    Default Re: Need some help with routine please

    Thanks for the replies.

    The burst code didn't work.

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

    Default Re: Need some help with routine please

    Quote Originally Posted by grayham.roper.146880 View Post
    Thanks for the replies.

    The burst code didn't work.
    You need to load it first => (load "burst.lsp")
    It will only autoload by entering "burst" at the command line.
    Tom Beauford P.S.M. - Civil 2020 on Windows 10 Enterprise
    Design Analysis - Leon County Public Works/Engineering Wrap [CODE] tags around selected text
    2280 Miccosukee Rd. Tallahassee, FL 32308-5310
    Ph# (850)606-1516 Home Page

Similar Threads

  1. Help with a lisp routine to add a 12" line to this routine
    By Orbytal.edge341183 in forum AutoLISP
    Replies: 3
    Last Post: 2012-11-14, 10:33 PM
  2. Combine three lisp routine into one routine.
    By BrianTFC in forum AutoLISP
    Replies: 1
    Last Post: 2012-02-08, 12:14 PM
  3. Replies: 9
    Last Post: 2007-06-13, 01:22 PM
  4. Replies: 2
    Last Post: 2007-05-11, 11:25 AM
  5. Replies: 2
    Last Post: 2007-04-20, 09:51 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
  •