Jump to content

Need Lisp Modified

Ryder76

By Ryder76
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Ryder76 Experienced

Ryder76

Posted
Posted

There is a thread in the General area that I responded to about a routine for an electrical wire jumper. rkent posted a lisp that is almost what I need. I need to add a feature to the routine that would define the ltscale at .4072 in the beginning and then redfine it back to 1 at the end. If it would auto repeat that would be way cool.

 

Any takers on this? Thanks in advance.:)

JUMPER.LSP

Link to comment
Share on other sites
  • Replies 24
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    10

  • Glen Smith

    4

  • Ryder76

    3

  • alanjt

    2

Popular Days

Top Posters In This Topic

Popular Days

Lee Mac Grand Master

Lee Mac

Posted
Posted

Hi Ryder,

 

I have slightly modified your code in that the Arc Radius may be specified at the top of the code.

 

I have also added an error handler :)

 

(defun c:jumper (/ *error* A B1 B2 BDIS ENT OV P1 P2 VL)

 (setq bDis 0.04072) ;; Arc Radius (Break Distance / 2.0 )

 (defun *error* (msg)
   (and ov (mapcar (function setvar) vl ov))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("CMDECHO" "OSMODE") ov (mapcar (function getvar) vl))

 (while (and (mapcar (function setvar) vl '(0 32))
             (setq p1 (getpoint "\nPick INTERSECTION: "))
             (setq ent (entsel "\nPick LINE TO BREAK: ")))

   (setq p2 (osnap (cadr ent) "_nea")
         b1 (polar p1 (setq a (angle p1 p2)) bDis)
         b2 (polar p1 (+ pi a) bDis))
   
   (setvar "OSMODE" 0)
   (command "_.break" b1 b2)
   (if (> a (/ pi 2.))
     (command "_.arc" b1 "_E" b2 "_A" 180.)
     (command "_.arc" b2 "_E" b1 "_A" 180.)))

 (mapcar (function setvar) vl ov)
 (princ))

Let me know if this works for you :)

Link to comment
Share on other sites
Glen Smith Rising Star

Glen Smith

Posted
Posted

I saw the other thread last night just before putting the kids to bed. I knew that I wanted to grab the code for work, but promptly forgot the thread name. This morning I remembered that I wanted the code and that Ryder had posted on the thread, so I searched on her name. And I find that Ryder has already asked Lee to put in an error handler and he has polished the code. :D

 

I took the liberty of adding undo marks to the new code so each jumper can be undone rather than undoing the arc, then the break. Otherwise, I'm certain to get caught sometime with a broken wire and no arc to connect it.

 

Thanks to all!

 

(defun c:jumper (/ *error* A B1 B2 BDIS ENT OV P1 P2 VL doc)

 (setq bDis 0.1) ;; Arc Radius (Break Distance / 2.0 )

 (defun *error* (msg)
   (and ov (mapcar (function setvar) vl ov))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("CMDECHO" "OSMODE") ov (mapcar (function getvar) vl))
 (while (and (mapcar (function setvar) vl '(0 32))
             (setq p1 (getpoint "\nPick INTERSECTION: "))
             (setq ent (entsel "\nPick LINE TO BREAK: ")))

   (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
   (vla-startUndoMark doc)

   (setq p2 (osnap (cadr ent) "_nea")
         b1 (polar p1 (setq a (angle p1 p2)) bDis)
         b2 (polar p1 (+ pi a) bDis))
   
   (setvar "OSMODE" 0)

   (command "_.break" b1 b2)
   (if (> a (/ pi 2.))
     (command "_.arc" b1 "_E" b2 "_A" 180.)
     (command "_.arc" b2 "_E" b1 "_A" 180.)))

   (vla-EndUndoMark doc)
  
 (mapcar (function setvar) vl ov)
 (princ))

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Tweaked as requested :D

 

(defun c:jumper (/ *error* A B1 B2 BDIS DOC ENT OV P1 P2 UFLAG VL)

 (setq bDis 0.04072) ;; Arc Radius (Break Distance / 2.0 )

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (and ov (mapcar (function setvar) vl ov))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
       vl '("CMDECHO" "OSMODE") ov (mapcar (function getvar) vl))

 (while (and (mapcar (function setvar) vl '(0 32))
             (setq p1 (getpoint "\nPick INTERSECTION: "))
             (setq ent (entsel "\nPick LINE TO BREAK: ")))
   
   (setq uFlag (not (vla-StartUndoMark doc)))

   (setq p2 (osnap (cadr ent) "_nea")
         b1 (polar p1 (setq a (angle p1 p2)) bDis)
         b2 (polar p1 (+ pi a) bDis))
   
   (setvar "OSMODE" 0)
   (command "_.break" b1 b2)
   (if (> a (/ pi 2.))
     (command "_.arc" b2 "_E" b1 "_A" 180.)
     (command "_.arc" b1 "_E" b2 "_A" 180.))

   (setq uFlag (vla-EndUndoMark doc)))

 (mapcar (function setvar) vl ov)
 (princ))

Link to comment
Share on other sites
Glen Smith Rising Star

Glen Smith

Posted
Posted

Thank you Lee, that works better than what I had. I have noticed that if I undo a jumper the OSNAPS are not set to the beginning values. I have always heard that phantom changes to your OSNAPS are often due to LISP's "misbehaving". But returning the OSNAPS has to be the last thing done in the LISP. How do you skip over returning the OSNAPS to the initial value, yet still allow the user to undo jumpers one at a time?

 

Glen

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Ah yes - I suppose this is a workaround:

 

(defun c:jumper (/ *error* A B1 B2 BDIS DOC ENT OV P1 P2 UFLAG VL)

 (setq bDis 0.04072) ;; Arc Radius (Break Distance / 2.0 )

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (and ov  (mapcar (function setvar) vl ov))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))))
   (princ))

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
       vl '("CMDECHO" "OSMODE") ov (mapcar (function getvar) vl))

 (while (and (setq uFlag (not (vla-StartUndoMark doc)))
             (mapcar  (function setvar) vl '(0 32))
             (setq p1 (getpoint "\nPick INTERSECTION: "))
             (setq ent (entsel "\nPick LINE TO BREAK: ")))

   (setq p2 (osnap (cadr ent) "_nea")
         b1 (polar p1 (setq a (angle p1 p2)) bDis)
         b2 (polar p1 (+ pi a) bDis))
   
   (setvar "OSMODE" 0)
   (command "_.break" b1 b2)
   (if (> a (/ pi 2.))
     (command "_.arc" b2 "_E" b1 "_A" 180.)
     (command "_.arc" b1 "_E" b2 "_A" 180.))

   (setq uFlag (vla-EndUndoMark doc)))

 (*error* nil)  
 (princ))

 

IMO, I would not change the OSMODE to 32 and leave the user to make sure that Intersection is enabled - saves a lot of hassle. :)

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
You are wonderful!:)

 

Thanks Ryder :)

 

You might want to use the latest code posting, as we found a small glitch with the UndoMarks within the code - the UNDO caused the OSMODE to be set to the state it was before the first UndoMark. Hopefully the latest code resolves this issue.

Link to comment
Share on other sites
Glen Smith Rising Star

Glen Smith

Posted
Posted

Lee,

 

Is there a way to check if the line that is broken is a PLINE and if so, join the arc with the two segments created by the break? I often use PLINEs with a width greater than the default for my wires to set them apart from the other drawing elements. After using the jumper routine, I then have to go back through and do a PEDIT on each line and join them. This keeps the wire as a single entity in case of future moves, and also happily sets the width of the new arc to the same as the other segments of the PLINE.

 

I know that this request is beyond my abilities.

 

Glen

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Try this Glen, nothing fancy, and not much error trapping:

 

(defun c:jumper (/ *error* A AENT B1 B2 BDIS BENT DOC ENT OV P1 P2 UFLAG VL)

 (setq bDis 0.04072) ;; Arc Radius (Break Distance / 2.0 )

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (and ov  (mapcar (function setvar) vl ov))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))))
   (princ))

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
       vl '("PEDITACCEPT" "CMDECHO" "OSMODE") ov (mapcar (function getvar) vl))
 (setvar "PEDITACCEPT" 1)

 (while (and (setq uFlag (not (vla-StartUndoMark doc)))
             (mapcar  (function setvar) (cdr vl) '(0 32))
             (setq p1 (getpoint "\nPick INTERSECTION: "))
             (setq ent (entsel "\nPick LINE TO BREAK: ")))

   (setq p2 (osnap (cadr ent) "_nea")
         b1 (polar p1 (setq a (angle p1 p2)) bDis)
         b2 (polar p1 (+ pi a) bDis))
   
   (setvar "OSMODE" 0)
   (command "_.break" b1 b2)
   (setq bEnt (entlast))
   (if (> a (/ pi 2.))
     (command "_.arc" b2 "_E" b1 "_A" 180.)
     (command "_.arc" b1 "_E" b2 "_A" 180.))
   (setq aEnt (entlast))

   (command "_.pedit" "_M" bEnt aEnt ent "" "_J" "" "")

   (setq uFlag (vla-EndUndoMark doc)))

 (*error* nil)  
 (princ))

Link to comment
Share on other sites
stevesfr Rising Star

stevesfr

Posted
Posted
Try this Glen, nothing fancy, and not much error trapping:

 

(defun c:jumper (/ *error* A AENT B1 B2 BDIS BENT DOC ENT OV P1 P2 UFLAG VL)

 (setq bDis 0.04072) ;; Arc Radius (Break Distance / 2.0 )

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (and ov  (mapcar (function setvar) vl ov))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))))
   (princ))

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
       vl '("PEDITACCEPT" "CMDECHO" "OSMODE") ov (mapcar (function getvar) vl))
 (setvar "PEDITACCEPT" 1)

 (while (and (setq uFlag (not (vla-StartUndoMark doc)))
             (mapcar  (function setvar) (cdr vl) '(0 32))
             (setq p1 (getpoint "\nPick INTERSECTION: "))
             (setq ent (entsel "\nPick LINE TO BREAK: ")))

   (setq p2 (osnap (cadr ent) "_nea")
         b1 (polar p1 (setq a (angle p1 p2)) bDis)
         b2 (polar p1 (+ pi a) bDis))

   (setvar "OSMODE" 0)
   (command "_.break" b1 b2)
   (setq bEnt (entlast))
   (if (> a (/ pi 2.))
     (command "_.arc" b2 "_E" b1 "_A" 180.)
     (command "_.arc" b1 "_E" b2 "_A" 180.))
   (setq aEnt (entlast))

   (command "_.pedit" "_M" bEnt aEnt ent "" "_J" "" "")

   (setq uFlag (vla-EndUndoMark doc)))

 (*error* nil)  
 (princ))

 

Almost, the arc is a pline and continuous with the pline, but the program (for the arc) doesn't pick up the initial width of the pline that is broken and arc inserted. (more dark side !)

S

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

This really is getting messy now... :geek: :(

 

(defun c:jumper (/ *error* A AENT B1 B2 BDIS BENT DOC ENT OV P1 P2 UFLAG VL O W)

 (setq bDis 0.04072) ;; Arc Radius (Break Distance / 2.0 )

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (and ov  (mapcar (function setvar) vl ov))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))))
   (princ))

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
       vl '("PEDITACCEPT" "CMDECHO" "OSMODE") ov (mapcar (function getvar) vl))
 (setvar "PEDITACCEPT" 1)

 (while (and (setq uFlag (not (vla-StartUndoMark doc)))
             (mapcar   (function setvar) (cdr vl) '(0 32))
             (setq p1  (getpoint "\nPick INTERSECTION: "))
             (setq ent (entsel "\nPick LINE TO BREAK: ")))

   (setq p2 (osnap (cadr ent) "_nea")
         b1 (polar p1 (setq a (angle p1 p2)) bDis)
         b2 (polar p1 (+ pi a) bDis))
   
   (setvar "OSMODE" 0)
   (command "_.break" b1 b2)
   (setq bEnt (entlast))
   (if (> a (/ pi 2.))
     (command "_.arc" b2 "_E" b1 "_A" 180.)
     (command "_.arc" b1 "_E" b2 "_A" 180.))
   (setq aEnt (entlast))

   (if (eq "LWPOLYLINE" (cdr (assoc 0 (entget (setq ent (car ent))))))
     (progn
       (setq w (vla-get-ConstantWidth (setq o (vlax-ename->vla-object ent))))
       (command "_.pedit" "_M" bEnt aEnt ent "" "_J" "" "")
       (vla-put-ConstantWidth (vlax-ename->vla-object (entlast)) w)))

   (setq uFlag (vla-EndUndoMark doc)))

 (*error* nil)  
 (princ))

Link to comment
Share on other sites
stevesfr Rising Star

stevesfr

Posted
Posted
This really is getting messy now... :geek: :(

 

(defun c:jumper (/ *error* A AENT B1 B2 BDIS BENT DOC ENT OV P1 P2 UFLAG VL O W)

 (setq bDis 0.04072) ;; Arc Radius (Break Distance / 2.0 )

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (and ov  (mapcar (function setvar) vl ov))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))))
   (princ))

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
       vl '("PEDITACCEPT" "CMDECHO" "OSMODE") ov (mapcar (function getvar) vl))
 (setvar "PEDITACCEPT" 1)

 (while (and (setq uFlag (not (vla-StartUndoMark doc)))
             (mapcar   (function setvar) (cdr vl) '(0 32))
             (setq p1  (getpoint "\nPick INTERSECTION: "))
             (setq ent (entsel "\nPick LINE TO BREAK: ")))

   (setq p2 (osnap (cadr ent) "_nea")
         b1 (polar p1 (setq a (angle p1 p2)) bDis)
         b2 (polar p1 (+ pi a) bDis))

   (setvar "OSMODE" 0)
   (command "_.break" b1 b2)
   (setq bEnt (entlast))
   (if (> a (/ pi 2.))
     (command "_.arc" b2 "_E" b1 "_A" 180.)
     (command "_.arc" b1 "_E" b2 "_A" 180.))
   (setq aEnt (entlast))

   (if (eq "LWPOLYLINE" (cdr (assoc 0 (entget (setq ent (car ent))))))
     (progn
       (setq w (vla-get-ConstantWidth (setq o (vlax-ename->vla-object ent))))
       (command "_.pedit" "_M" bEnt aEnt ent "" "_J" "" "")
       (vla-put-ConstantWidth (vlax-ename->vla-object (entlast)) w)))

   (setq uFlag (vla-EndUndoMark doc)))

 (*error* nil)  
 (princ))

 

not messy, just PERFECT... thanks for making EE's happy !

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.

×
 Share
Go to topic listing
×
×
  • Create New...