Results 1 to 2 of 2

Thread: Combine three lisp routine into one routine.

  1. #1
    Member
    Join Date
    2012-01
    Posts
    11
    Login to Give a bone
    0

    Default Combine three lisp routine into one routine.

    Hi All,

    I need some help i have three lisp routines that i would like to combine into one routine. they all use the same objects to get their results so i was wondering if there was a way to combine them together. the order of would be as follows:

    1. olo (Offset Polylines)
    2. exl (Extrusion Lengths) the only that i see with this one is that it requires use input for placement, i would for it to place the results to the outside of lines. run the lisp routine by creating a rectangle exploded to see what it does.
    3. pte (Panel Tab Extension)

    They all run perfectly by themselves, but im just trying to speed up the process. Here are the codes that i'm using. any help would be appreciated.
    .

    thanks,
    Brian

    Code:
     
    ;|    OFFSET POLYLINES
     mfuccaro@hotmail.com    September 2003
     |;
    (defun c:olo( / plines    ; selection set of polylines
                ext    ; extrnal point
                 dist    ; distance to offset
                 poly    ; a polyline from plines
                 plist    ; the list of poly
                 del    ; polyline to delete
                 int    ; internal point
                 i)
      (command "undo" "begin")
      (princ "select polylines")
      (setq plines (ssget)
        i 0
        ext (getvar "limmax")
        dist (getdist (strcat "distance <" (if olddist
                                              (rtos olddist)   ;use old value as default
                                               "") ">"))) 
      (if (not dist) (setq dist olddist))                      ;reuse old distance if user press <Enter>
      (repeat (sslength plines)
        (setq poly (ssname plines i))
        (setq plist (entget poly))
        (command "offset" dist poly ext "")
        (setq del (entlast)
          int (polar
            (cdr (assoc 10 (entget del)))
                 (angle
                   (cdr (assoc 10 (entget del)))
                   (cdr (assoc 10 plist)))
                 (* 2 (distance (cdr (assoc 10 plist))
                        (cdr (assoc 10 (entget del)))))))
        (command "offset" dist poly int "")
         (command "_.change" (entlast) "" "_p" "_la" (getvar 'clayer) "")
       (entdel del)
        (setq i (1+ i)))
      (command "undo" "end")
      (setq olddist dist)                                      ;preserve current distance for next run
      (princ)
      )
     
    ;Extrusion Length
    (defun c:EXTL (/ cEnt tStr tBox tHgt tWid gr sPt cPt lAng bPt tPt pt1 pt2 pt3 pt4)
      (vl-load-com)
      (if (and (setq cEnt (car (entsel "\nSelect Object: ")))
               (member (cdr (assoc 0 (entget cEnt)))
                       '("LWPOLYLINE" "POLYLINE" "LINE")))
        (progn
          (setq tStr (strcat "1@" (rtos (- (vla-get-length
                             (vlax-ename->vla-object cEnt)) 4.0)) (strcat "''"))
                tBox (textbox (list (cons 1 tStr) (cons 40 (getvar "TEXTSIZE"))))
                tHgt (- (cadadr tBox) (cadar tBox))
                twid (- (caadr tBox) (caar tBox)))
          (princ "\nPosition Text...")
          (while (eq 5 (car (setq gr (grread t 5 0))))
            (redraw)
            (if (listp (setq sPt (cadr gr)))
              (progn
                (setq cPt  (vlax-curve-getClosestPointto cEnt sPt)
                      lAng (angle cPt sPt)
                      bpt  (polar cPt lAng (/ (getvar "TEXTSIZE") 2.))
                      tpt  (polar bpt lAng tHgt)
                      mPt  (polar bPt lAng (/ tHgt 2.))
                      pt1  (polar bpt (+ lAng (/ pi 2.)) (/ tWid 2.))
                      pt2  (polar bPt (- lAng (/ pi 2.)) (/ tWid 2.))
                      pt3  (polar tpt (+ lAng (/ pi 2.)) (/ tWid 2.))
                      pt4  (polar tPt (- lAng (/ pi 2.)) (/ tWid 2.)))
                (grvecs (list -3 pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4)))))
          (if (eq 3 (car gr))
            (progn
              (setq lAng (- lAng (/ pi 2.)))
              (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                     (setq lAng (- lAng pi)))
                    ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                     (setq lAng (+ lAng pi))))
              (Make_Text mPt tStr lAng))))
        (princ "\n<!> Incorrect Selection <!>"))
      (redraw)
      (princ))
    (defun Make_Text  (pt val rot)
      (entmake
        (list
          (cons 0 "TEXT")
          (cons 8 (getvar "CLAYER"))
          (cons 62 1)
          (cons 10 pt)
          (cons 40 (getvar "TEXTSIZE"))
          (cons 1 val)
          (cons 50 rot)
          (cons 7 (getvar "TEXTSTYLE"))
          (cons 71 0)
          (cons 72 1)
          (cons 73 2)
          (cons 11 pt))))
     
    ;;; PANEL TAB EXTENSIONS
    (defun c:PTE(/ lSet actDoc lDel doMode objLst)
    (vl-load-com)
    (princ "\n>>> Select lines to extend/reduce <<< ")
    (if
    (and
    (setq lSet
    (ssget
    '((0 . "LINE"))));
    (setq lDel
    (getreal "\nSpecify : "))
    ); end and
    (progn
    (initget 1 "Positive Negative Both")
    (setq doMode
    (getkword "\nSpecify direction [Positive/Negative/Both]: ")
    objLst(mapcar 'vlax-ename->vla-object
    (vl-remove-if 'listp 
    (mapcar 'cadr(ssnamex lSet))))); end setq
    (vla-StartUndoMark
    (setq actDoc
    (vla-get-ActiveDocument
    (vlax-get-acad-object)))); end vla-StartUndoMark
    (if(member doMode '("Negative" "Both"))
    (foreach ln objLst
    (vlax-put ln 'startpoint
    (polar
    (vlax-get ln 'startpoint)
    (vlax-get ln 'angle)(- lDel))); end vlax-put
    ); end foreach
    ); end if
    (if(member doMode '("Positive" "Both"))
    (foreach ln objLst
    (vlax-put ln 'endpoint
    (polar
    (vlax-get ln 'endpoint)
    (vlax-get ln 'angle)lDel))
    ); end foreach
    ); end if
    (vla-EndUndoMark actDoc)
    ); end progn
    ); end if
    (princ)
    )

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

    Default Re: Combine three lisp routine into one routine.

    Try:
    Code:
     (defun c:oloEXTLPTE ()
      (load "lispfiles.lsp")
      (c:olo)
      (c:EXTL)
      (c:PTE)
    )

Similar Threads

  1. GA lisp routine help
    By pgastelum77763 in forum AutoLISP
    Replies: 15
    Last Post: 2016-11-16, 06:25 PM
  2. NEED HELP WITH LISP ROUTINE - PURGE linetype lisp
    By ECASAOL350033 in forum AutoLISP
    Replies: 6
    Last Post: 2013-06-21, 01:13 AM
  3. 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
  4. Replies: 9
    Last Post: 2012-01-21, 07:58 AM
  5. Replies: 2
    Last Post: 2007-04-20, 09:51 AM

Tags for this Thread

Posting Permissions

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