Jump to content

Help to modify existing lisp


dnovember99

Recommended Posts

Hey all,

 

(Sorry if this is long)I found a lisp that I think is absolutely amazing in itself the way it works. I wanted to find out if someone would be able to help me modify this a little. I tried but my English isn’t understood by a computer!

 

So this is a break all lisp (see below) this was originally created by Lee McDonnell back in 2009. (So big thank you for this.)

Everything that I am talking about is in 2D.

I wanted to find out if there is a way that I could modify this to have specific layers (example: cold water, hot water ETC.) can be given a value to state “anytime layer A and layer B cross, layer B will break with a specific distance (I normally do 3” on either side of the line) to show that layer B is “lower” than layer A”

 

I know that with 2D there is no height’s. With the projects that I am working on we have a lot of pipes crossing and I wanted to be able to speed things up. Right now I am having to do one intersection at a time. Here is a list of the piping that I use (what I put inside of these () is just want the pipe is, thought that might help to provide a value to what would be over the other.)

 

PNDCW (COLD WATER)

PNDHW (HOT WATER)

PNHWR (HOT WATER RETURN)

PNDCW RO (RO WATER)

PNDCW ROR (REMINERILIZED RO WATER)

PNDCW RO-B (RO WATER BELOW FLOOR)

PNDCW ROR-B (REMINERILIZED RO WATER BELOW FLOOR)

PNGWB (GREASE WASTE)

PNSNB (GREASE WASTE)

PNVNT (VENT)

VBF-PIPING (VENT BELOW FLOOR)

Here is the lisp that I am starting with.

 

 

 

;;; Break All, by Lee McDonnell.  25/07/2009

(defun c:brkAll (/ *error* doc spc ss Objlst Obj iLst Altlst lst)
 (vl-load-com)

 (defun *error* (msg)
   (if doc (vla-EndUndoMark doc))
   (if ov (mapcar 'setvar vl ov))
   (if (not
         (wcmatch
           (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ
       (strcat "\n** Error: " msg " **")))
   (princ))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 
 (setq vl '("CMDECHO" "OSMODE")
       ov (mapcar 'getvar vl))
 
 (vla-StartUndoMark doc)
 (or *brk$dis* (setq *brk$dis* 5.))
 (if (setq ss (ssget '((0 . "*LINE,ARC"))))
   (progn
     (or (not
           (setq tmp
             (getdist
               (strcat "\nSpecify Break Distance <" (rtos *brk$dis* 2 2) "> : "))))
         (setq *brk$dis* tmp))
     (setq Objlst
       (mapcar 'vlax-ename->vla-object
         (vl-remove-if 'listp
           (mapcar 'cadr (ssnamex ss)))))
     (while (setq Obj (car Objlst))
       (foreach iObj (setq Objlst (cdr Objlst))
         (setq iLst
           (cons
             (cons Obj
               (vlax-list->3D-point
                 (vlax-invoke Obj
                   'IntersectWith iObj acExtendNone))) iLst))))
     (mapcar 'setvar vl '(0 0))
     (foreach Int (vl-remove-if-not
                    (function
                      (lambda (x)
                        (vl-consp (cdr x)))) iLst)
       (setq Obj (car Int))
       (foreach Pt (cdr Int)
         (and Altlst (setq lst Altlst))
         (if (not (setq bDis (vlax-curve-getDistatPoint Obj Pt)))
           (while (and (not bDis) lst)
             (setq bDis (vlax-curve-getDistatPoint (setq Obj (car lst)) Pt)
                   lst (cdr lst))))
         (if bDis
           (progn
             (or (setq bPt1 (vlax-curve-getPointatDist Obj
                              (+ bDis (/ *brk$dis* 2.))))
                 (setq bPt1 (vlax-curve-getEndPoint Obj)))
             (or (setq bPt2 (vlax-curve-getPointatDist Obj
                              (- bDis (/ *brk$dis* 2.))))
                 (setq bPt2 (vlax-curve-getStartPoint Obj)))
             (command "_.Break"
               (list (vlax-vla-object->ename Obj) pt) "_F" bPt1 bPt2)
             (setq AltLst (cons (vlax-ename->vla-object (entlast)) AltLst)))))))
   (princ "\n** Nothing Selected **"))
 (vla-EndUndoMark doc)
 (mapcar 'setvar vl ov)
 (princ))
             

(defun vlax-list->3D-point (lst)
 (if lst
   (cons (list (car lst) (cadr lst) (caddr lst))
         (vlax-list->3D-point (cdddr lst)))))

2017_11_29_09_17_06_Autodesk_AutoCAD_2016_H_AUTOCAD_TIPS_AND_TRICKS_SPROUTS_GO_BY_S_LAYOUOT_EXAM.png

Edited by dnovember99
Link to comment
Share on other sites

thank you for the reply. as much as i appriecate that little bit of knowledge, i am so new to learning LISP (like 2 days new) that i am still sitting here with a blank stare. i know what i want things to do and i can picture it but my brain cant get my fingers to execute this.

Link to comment
Share on other sites

thank you for the reply. as much as i appriecate that little bit of knowledge, i am so new to learning LISP (like 2 days new) that i am still sitting here with a blank stare. i know what i want things to do and i can picture it but my brain cant get my fingers to execute this.

 

An animated picture is worth a thousand words 8)

Link to comment
Share on other sites

ok, well i am going to sound really dumb here. but how would i do that? being on a work computer i cant download anything? any ideas?

 

but in that picture, i have 3 lines running north to south. (hot water, cold water and hot water return.) and the other pipes are the "RO" water, it i just want to break the lines and always have it be the same. sorry if i am making it worse, just trying to explain it the only way i know how to.

Link to comment
Share on other sites

Nothing to download or install. Just click [Edit Post] at the bottom of your post, select the code, and click the # button on the toolbar to place the code tags. Did you look at the animated picture or read the Code posting guidelines?

Link to comment
Share on other sites

i am sorry no i didnt read the posting guidelines, that is my fault. i am very new to the fourm stuff so that is totally my fault. i will go back and edit.

 

thank you for pointing this out for me. i will remember this for any future posts.

Link to comment
Share on other sites

Have you tried THIS?

c:BreakAll - Break all objects selected

c:BreakwObjects - Break many objects with a single object

c:BreakObject - Break a single object with many objects

c:BreakWith - Break selected objects with other selected objects

c:BreakTouching - Break objects touching the single Break object

c:BreakSelected - Break selected objects with any objects that touch it

c:MyBreak - Dialog with buttons to run three of the routines

c:BreakRemove - Break selected object with any objects that touch it & remove

every other new segment, start with selected object

Link to comment
Share on other sites

Ok so i found another break multi line lisp that was wrote. by Fatty T.O.H. () 2006 *

 

i hope that i added that right.

 

so i was thinking really if you are able to add to this or modify this to take that one common line it refers to, (what ever layer that is on) and give that layer a value of 1. and then copy that for the number of layers listed above. (total of 11) so you will have a value set from 1-11. so i am thinking that as the value goes up then hypothetically thinking the lower the pipe would be. at each intersection would create a break with a break of 3" on either side and using the intersection at the midpoint.

 

let me know if i am running further out in left field with this one or not.

 

thanks again for all your help and support.

Link to comment
Share on other sites

Have you tried THIS?

 

ronjomp i have seen that, but again with being so new at reading all this stuff i thought that was just a description. i will have to give that a try and see if that will do it. i guess i was just looking at something that could be a little more automated. set it and for get it i guess. :unsure::unsure::ouch::ouch::?:?

Link to comment
Share on other sites

:oops: Well I tried something, but didn't expected that Lee had to proccess the resulting objects after the break command, so I'll just leave my frustrating broken attempt here as a start for someone else:

 

(defun C:test ( / vlax-list->3D-point _MyBrk$dist _unique _getbrk$dist SS oL sLyrs kbL bkL d tmp ibsL en )
 
 (defun vlax-list->3D-point (lst)
   (if lst
     (cons (list (car lst) (cadr lst) (caddr lst))
       (vlax-list->3D-point (cdddr lst))
     )
   )
 )
 
 (setq _MyBrk$dist 
   (lambda (e xL / o pL e tmpL L bDis bPt1 bPt2 tmpeL )
     (cond 
       ( (and (vl-every 'set '(o pL) (list (car xL) (cdr xL))) (eq 'VLA-OBJECT (type o)))
         ; (setq e (entlast))
         (foreach p pL
           (and tmpL (setq L tmpL))
           (if (not (setq bDis (vlax-curve-getDistatPoint o p)))
             (while (and (not bDis) L)
               (setq bDis (vlax-curve-getDistatPoint (setq o (car L)) p))
               (setq L (cdr L))
             )
           )
           (if bDis
             (progn
               (or 
                 (setq bPt1 (vlax-curve-getPointatDist o (+ bDis (/ *brk$dis* 2.))))
                 (setq bPt1 (vlax-curve-getEndPoint o))
               )
               (or 
                 (setq bPt2 (vlax-curve-getPointatDist o (- bDis (/ *brk$dis* 2.))))
                 (setq bPt2 (vlax-curve-getStartPoint o))
               )
               (progn
                 (command "_.BREAK" (list (vlax-vla-object->ename o) p) "_F" bPt1 bPt2)
                 (foreach x 
                   ((lambda ( / tmp ) (setq tmp (entnext e)) (while tmp (setq tmpeL (cons (vlax-ename->vla-object tmp) tmpeL)) (setq tmp (entnext tmp)))  tmpeL))
                   (_MyBrk$dist (entlast) (cons x pL))
                 )
                 
               ); progn
               (setq tmpL (cons (vlax-ename->vla-object (entlast)) tmpL))
             )
           )
         ); foreach
         ; (if tmpeL (mapcar '(lambda (x) (_MyBrk$dist (cons x pL))) reL) tmpeL)
       )
     ); cond
   ); lambda
 ); setq _MyBrk$dist
 
 (setq _unique (lambda ( L / r ) (foreach x L (or (member x r) (setq r (cons x r))) ) r))
 
 (setq _getbrk$dist
   (lambda ( / tmp ) 
     (if
       (or 
         (and 
           (setq tmp (getdist (strcat "\nSpecify Break Distance " (if *brk$dis* (strcat "<" (rtos *brk$dis* 2 2) ">") "") " : ")))
           (setq *brk$dis* tmp)
         )
         *brk$dis*
       )
       *brk$dis*
     )
   )
 ); setq _getbrk$dist
 
 (cond 
   ( (not (setq SS (ssget "_:L"))) (prompt "\nNothing selected.") )
   ( ((lambda ( / i ) (repeat (setq i (sslength SS)) (setq oL (cons (vlax-ename->vla-object (ssname SS (setq i (1- i)))) oL))) nil)) )
   ( (not (setq kbL (LM:listbox "*~> Layers That will Break <~*" (setq sLyrs (_unique (mapcar 'vla-get-Layer oL))) 1))) )
   ( (not (setq bkL (LM:listbox "<~* Choose Layers To Be Broken *~>" (vl-remove-if (function (lambda (x) (member x kbL))) sLyrs) 1))) )
   ( (not (setq d (_getbrk$dist))) (prompt "\nBreak Distance not specified.") )
   (T
     (foreach o oL
       (and (member (vla-get-Layer o) kbL)
         (setq tmp (apply 'append (mapcar (function (lambda (x) (cond ((equal o x) nil) ( (member (vla-get-Layer x) bkL) (list x))))) oL)))
         (setq ibsL (cons (cons o tmp) ibsL)) ; list of lists: [CAR = breaking layer] [CDR = layers that must be broken]
       ); and
     ); foreach
     (setq en (entlast))
     (mapcar 
       '(lambda (x) ( _MyBrk$dist en x))
       ; '(lambda (x / e ) (setq e (vlax-vla-object->ename (car x))) (mapcar '(lambda (xx) (LM:breakobject e xx xx xx (entget e))) (cdr x))) ; ent pt1 pt2 bpt dxf
       (apply 'append ; List of lits: [CAR = object to break] [CDR = points at it should be broken]
         (apply 'append
           (mapcar
             (function 
               (lambda (x / o L)
                 (if (vl-every 'set '(o L) (list (car x) (cdr x)))
                   (list
                     (apply 'append
                       (mapcar 
                         (function 
                           (lambda (xx / tmp)
                             (if (setq tmp (vlax-list->3D-point (vlax-invoke o 'IntersectWith xx acExtendNone)))
                               (list (cons xx tmp))
                             )
                           )
                         )
                         L
                       )
                     )
                   )
                 )
               ); lambda
             ); function
             ibsL
           ); mapcar
         ); apply 'append
       ); apply 'append
     ); mapcar
   ); T
 ); cond
 (princ)
); defun

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...