Results 1 to 2 of 2

Thread: Can you help me in this lisp please

  1. #1
    Member
    Join Date
    2011-02
    Posts
    2
    Login to Give a bone
    0

    Default Can you help me in this lisp please

    I have found this lisp and its very helpfull
    Code:
    ;; based on Inline.lsp by John Uhden
    ;; modified Joe Burke 5/15/03
    ;; pick a line, arc or lwpline
    ;; creates a selection set of objects which meet end to end
    ;; only selects objects on the same layer as picked object
    ;; pass selection set to pedit join...
    ;; CUT_LIST.LSP (c)1995-96, John F. Uhden, CADvantage
    ;; This function deletes the first instance of an item from a list:
    ;; Corrected thanks to trouble shooting by Peter B. Tobey
    (defun @cv_cut_list (|item |list / |m)
      (if (setq |m (member |item |list))
        (progn
          (setq |list (reverse |list))
          (repeat (length |m) (setq |list (cdr |list)))
          (append (reverse |list) (cdr |m))
        )
        |list
      )
    ) ;end
    (defun @arc (ent / e rp r ba ea p1 p2)
      (setq e  (cdr (assoc -1 ent))
            rp (cdr (assoc 10 ent))
            r  (cdr (assoc 40 ent))
            ba (cdr (assoc 50 ent))
            ea (cdr (assoc 51 ent))
            p1 (trans (polar rp ba r) e 0)
            p2 (trans (polar rp ea r) e 0)
      )
      (list e p1 p2)
    ) ;end
    (defun @line (ent)
      (list
        (cdr (assoc -1 ent))
        (cdr (assoc 10 ent))
        (cdr (assoc 11 ent))
      )
    ) ;end
    (defun @pline (ent / e)
      (setq e (cdr (assoc -1 ent)))
      (list
        e
        (car (getends e))
        (cadr (getends e))
      )
    ) ;end
    (defun @list (e / ent)
      (setq ent (entget e))
      (cond
        ((= (cdr (assoc 0 ent)) "LINE")
         (setq sslist (cons (@line ent) sslist))
        )
        ((= (cdr (assoc 0 ent)) "ARC")
         (setq sslist (cons (@arc ent) sslist))
        )
        ((= (cdr (assoc 0 ent)) "LWPOLYLINE")
         (setq sslist (cons (@pline ent) sslist))
        )
      )
    ) ;end
    (defun @closest (sym / item e p1 p2 i found)
      (setq i 0
            p (eval sym)
      )
      (while (and (not found) (< i (length sslist)))
        (setq item (nth i sslist)
              e    (car item)
              p1   (cadr item)
              p2   (caddr item)
              i    (1+ i)
        )
        (cond
          ((equal p p1 fuzz)
           (setq found 1)
           (set sym p2)
          )
          ((equal p p2 fuzz)
           (setq found 1)
           (set sym p1)
          )
        )
      )
      (cond
        ((not found) nil)
        ((= sym 'start)
         (setq elist (cons e elist))
         (setq sslist (@cv_cut_list item sslist))
        )
        ((= sym 'end)
         (setq elist (reverse (cons e (reverse elist))))
         (setq sslist (@cv_cut_list item sslist))
        )
      )
    ) ;end
     ;argument: an ename - returns: Start and End points as a list
    (defun getends (vobj / name stpt endpt)
      (if (= (type vobj) 'ename)
        (setq vobj (vlax-ename->vla-object vobj))
      )
      (and
        (setq name (vla-get-objectname vobj))
        (cond
          ((vl-position
             name
             '("AcDbArc"           "AcDbLine"          "AcDbEllipse"
               "AcDbSpline"        "AcDbPolyline"      "AcDb2dPolyline"
               "AcDb3dPolyline"
              )
           )
           (setq stpt (vlax-curve-getstartpoint vobj))
           (setq endpt (vlax-curve-getendpoint vobj))
          )
        ) ;cond
      ) ;and
      (list stpt endpt)
    ) ;end
    ;; -------------------------------
    ;; main function
    ;; renamed Inline.lsp by John Uhden
    (defun c:ssend2end (/      sslist elist  ss     ssres  i      e
                        ent    ok     start  end    fuzz   layer  ssex
                        typlst
                       )
      (if
        (and
          (cadr (ssgetfirst)) ;objects are selected
     ;at least one arc, line or pline
          (setq ssex (ssget "i" (list (cons 0 "LINE,ARC,LWPOLYLINE"))))
        ) ;and
         (setq e (ssname ssex 0)) ;then
         (progn ;else
           (sssetfirst)
           (setq typlst '("LINE" "ARC" "LWPOLYLINE"))
           (while
             (or
               (not (setq e (car (entsel "\nSelect line, pline or arc: "))))
               (not (member (cdr (assoc 0 (entget e))) typlst))
             )
              (princ "\nMissed pick or wrong object type: ")
           ) ;while
         ) ;progn
      ) ;if
      (and
        (setq ok   1
              fuzz 1e-8
        )
        (setq ent (entget e))
        (setq layer (cdr (assoc 8 ent)))
        (cond
          ((= (cdr (assoc 0 ent)) "ARC")
           (setq ent (@arc ent))
          )
          ((= (cdr (assoc 0 ent)) "LINE")
           (setq ent (@line ent))
          )
          ((= (cdr (assoc 0 ent)) "LWPOLYLINE")
           (setq ent (@pline ent))
          )
        )
        (setq elist (list e)
              start (cadr ent)
              end   (caddr ent)
        )
        (setq ss
               (ssget "X" (list '(0 . "LINE,ARC,LWPOLYLINE") (cons 8 layer)))
        )
        (ssdel e ss)
        (setq i 0)
        (repeat (sslength ss)
          (@list (ssname ss i))
          (setq i (1+ i))
        ) ;repeat
        (while ok
          (setq ok
                 (or
                   (@closest 'start)
                   (@closest 'end)
                 )
          )
          1
        ) ;while
      ) ;and
      (setq ssres (ssadd))
      (foreach x elist
        (ssadd x ssres)
      )
      (sssetfirst nil ssres)
      (princ)
    ) ;end
    ;; -------------------------------
     ;shortcut
    (defun c:e2e () (c:ssend2end))



    so the question is when you use this lisp it allows you to pick once can I make him pick more than one set ( continue selecting without loosing the selection ) < please help me cause I dont know anything in lisp world
    Last edited by rkmcswain; 2012-04-24 at 06:23 PM. Reason: Added [CODE] tags

  2. #2
    I could stop if I wanted to
    Join Date
    2005-06
    Location
    CORDOBA-ARGENTINA
    Posts
    275
    Login to Give a bone
    0

    Default Re: Can you help me in this lisp please

    What do you want to do after it .

Similar Threads

  1. Replies: 13
    Last Post: 2014-01-20, 06:14 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. Replies: 3
    Last Post: 2012-05-07, 08:16 PM
  4. Replies: 9
    Last Post: 2012-01-21, 07:58 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
  •