Looking for a LISP routine: Multiple Polyline Offset

[ReMark]

When I was out poking around the Internet yesterday I came across a multiline offset command that gave the user the option of retaining or deleting the centerline. Wouldn't a feature like that eliminate the "odd number" of lines problem?

[David Bethel]

To permanently disable the center line on mine, remark ( add ; to the beginning ) these lines like this:

 

;;;CENTER LINE
;  (command "_.PLINE")
;  (foreach p pl
;     (command p))
;  (command "")

 

To make it an option is not too dificult

 

Speaking off, how the crap can y'all write so much code so quickly? Ugh... I'm always so envious of programmers that can "whip something up".

- Tannar

 

It's a little like being bi-lingual. It starts to become a more true language the more you mess with it. Listening to someone try to vocalize lisp can be very funny. (cdr) comes out 'cud-der' Try ( assoc )

 

Anyway, I already have similar programs that offset a center line with a profile for things like the tray shown here. So the guts were already made

[David Bethel]

BTW, nice use of grdraw. I considered that, but was just lazy. Bravo.

 

 

Thanks, I was trying to remember hot clear grdraw lines so that the previous miter would show correctly. I cheated a left the temps line showing 1 junction prior to the current input.

 

On a black background ( I use ) , I think (grdraw p1 p2 250 1) would overlay a solid black line. I don't know what it would do on a white back. -David

[David Bethel]

QMLine 1.1 with center line option. -David

QMLINE.LSP

[VVA]

So I can only have an odd number of PLINES (3, 5, 7, etc). So, come to think of it due to my lack of a programmers approach, I created an odd number of PLINES only.

That might have been before the Duct/Pipe program came around from ASMI which is the most phenomenal program for double line. I'm looking for an unlimited amount of entries (in theory).

Another lisp from the ASMI with the Russian-speaking forum. (Smirnoff) = ASMI

LISP. Simultaneous tracing 2 - 16 polylines. Convenient for tracing cables.

And Code

(defun c:mpl(/ ptOpt oldQuont oldJust oldOff stPt mlName lastEnt
       firEnt lnSet oldEcho rLst *error*)
 (vl-load-com)
(defun [b][color="red"]asmi-mlStyleCreate[/color][/b](Quont / dxfLst topOrd Count mlDict)
 (setq dxfLst
  (list'(0 . "MLINESTYLE")'(102 . "{ACAD_REACTORS")'(102 . "}")
   '(100 . "AcDbMlineStyle")(cons 2(strcat(itoa Quont)"_PLINES"))
   '(70 . 0)'(3 . "")'(62 . 256)'(51 . 1.5708)'(52 . 1.5708)
    (cons 71 Quont))
      Count 0.0
      topOrd(-(/ Quont 2.0) 0.5)
  ); end setq
 (repeat Quont
   (setq dxfLst(append dxfLst
        (list(cons 49(- topOrd Count))
             '(62 . 256) '(6 . "BYLAYER")))
    Count(1+ Count)
    );end setq
   ); end repeat
   (if
    (null
     (member
  (assoc 2 dxfLst)(dictsearch(namedobjdict)"ACAD_MLINESTYLE")))
   (progn
     (setq mlDict
       (cdr
         (assoc -1(dictsearch(namedobjdict)"ACAD_MLINESTYLE"))))
     (dictadd mlDict
         (cdr(assoc 2 dxfLst))(entmakex dxfLst))
     ); end progn
   ); end if
   (strcat(itoa Quont)"_PLINES")
   ); end of
 (defun asmi-LayersUnlock(/ restLst)
 (setq restLst '())
 (vlax-for lay(vla-get-Layers
      (vla-get-ActiveDocument
        (vlax-get-acad-object)))
   (setq restLst
     (append restLst
        (list
          (list
          lay
          (vla-get-Lock lay)
          ); end list
          ); end list
        ); end append
    ); end setq
   (vla-put-Lock lay :vlax-false)
   ); end vlax-for
 restLst
 ); end of asmi-LayersUnlock
 (defun asmi-LayersStateRestore
      (
  StateList
  )
 (foreach lay StateList
   (vla-put-Lock(car lay)(cadr lay))
   ); end foreach
 (princ)
 ); end of asmi-LayersStateRestore
 (defun *error*(msg)
   (if(and lastEnt(not(equal lastEnt(entlast))))
     (command "_.erase" (entlast) "")
     ); end if
   (setvar "CMDECHO" oldEcho)
   (if rLst
     (asmi-LayersStateRestore rLst)
     ); end if
   (princ msg)
   ); end of *error*
 (if(not mpl:quont)(setq mpl:quont 2))
 (if(not mpl:just)(setq mpl:just "Zero"))
 (if(not mpl:off)(setq mpl:off 40.0))
 (setq ptOpt T
  oldQuont mpl:quont
  oldJust mpl:just
  oldOff mpl:Off
  oldEcho(getvar "CMDECHO")
  ); end setq
 (while(and ptOpt(/= 'LIST (type ptOpt)))
 (princ
   (strcat "\n>>> Quantity = " (itoa mpl:quont)
      ", Justification = " mpl:just
      ", Offset = " (rtos mpl:off) " <<< "
      ); end strcat
   ); end princ
 (initget 128)
 (setq ptOpt
   (getpoint
     (strcat "\nSpecify start point or [Quantity/Justification/Offset]: ")))
   (if(=(type ptOpt) 'STR)
     (setq ptOpt(strcase ptOpt))
     ); end if
   (cond
      ((= 'LIST(type ptOpt))
      (setq stPt ptOpt)
      (princ "\nSpecify next point or [undo]: ")
      ); end condition #1
     ((= ptOpt "Q")
      (setq mpl:quont
        (getint
     (strcat "\nSpecify quantity from 2 to 16 <"(itoa mpl:quont)">: ")))
      (if(null mpl:quont)(setq mpl:quont oldQuont))
      (if(or(< mpl:quont 2)(> mpl:quont 16))
   (progn
     (setq mpl:quont oldQuont)
     (princ "\nOnly from 2 to 16 polylines are available. ")
     ); end progn
   ); end if
      ); end condition #2
     ((= ptOpt "J")
      (initget "Zero Top Bottom")
      (setq mpl:just
        (getkword
     (strcat "\nSpecify justification [Zero/Top/Bottom] <" mpl:just ">: ")))
      (if(null mpl:just)(setq mpl:just oldJust))
      ); end condition #4
     ((= ptOpt "O")
      (initget 2)
      (setq mpl:off
        (getdist
     (strcat "\nSpecify offset distance <" (rtos mpl:off) ">: ")))
      (if(null mpl:off)(setq mpl:off oldOff))
      ); end condition #5
     ((if(member ptOpt
       '("2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16"))
      (setq mpl:quont(atoi ptOpt))
      ); end if
     ); end condition #6
     ((if(member ptOpt
      '("Z" "T" "B"))
   (setq mpl:just(cadr
           (assoc(strcase ptOpt)
           '(("Z" "Zero")("T" "Top")("B" "Bottom"))))
         ); end setq
    ); end if
   ); end condition #7
     ((if(member ptOpt
       '("2Z" "2T" "2B" "3Z" "3T" "3B" "4Z" "4T" "4B" "5Z" "5T" "5B"
         "6Z" "6T" "6B" "7Z" "7T" "7B" "8Z" "8T" "8B" "9Z" "9T" "9B"
         "10Z" "10T" "10B" "11Z" "11T" "11B" "12Z" "12T" "12B"
         "13Z" "13T" "13B" "14Z" "14T" "14B" "15Z" "15T" "15B"
         "16Z" "16T" "16B"))
     (setq mpl:quont
       (atoi(substr ptOpt 1(1-(strlen ptOpt))))
      mpl:just(cadr
           (assoc(substr(strcase ptOpt)(strlen ptOpt)1)
           '(("Z" "Zero")("T" "Top")("B" "Bottom"))))
      ); end setq
    ); end if
  ); end condition #8
     ((if ptOpt(princ "\nInvalid option keyword. "))
      ); end condition #9
     ); end cond
   ); end while
 (if ptOpt
   (progn
 (setq mlName(asmi-mlStyleCreate mpl:quont))
 (if(entlast)
 (setq lastEnt(entlast))
   ); end if
 (setvar "cmdecho" 0)
 (command "_.mline"
    "_ST" mlName
    "_S" mpl:off
    "_J" (strcat "_" mpl:just)
        stPt)
   (setvar "CMDECHO" 1)
   (while(= 1(getvar "CMDACTIVE"))
   (command pause)
   ); end while
 (setvar "CMDECHO" 0)
 (if(or(not lastEnt)(not(equal lastEnt (entlast))))
   (setq lastEnt(entlast))
   (setq lastEnt nil)
   ); end if
 (if lastEnt
   (progn
   (setq rLst(asmi-LayersUnlock))
   (command "_.explode" lastEnt)
   (setq lnSet(ssadd))
   (ssadd
     (setq lastEnt
       (entnext lastEnt))
                lnSet); end setq
 (while
   (setq lastEnt(entnext lastEnt))
   (if lastEnt(ssadd lastEnt lnSet))
   ); end while
 (cond
   ((or
      (and lnSet(not(getvar "PEDITACCEPT")))
      (and lnSet(=(getvar "PEDITACCEPT")0))
      ); end or
   (command "_.pedit" "_m" lnSet "" "_y" "_j" "0.0" "")
    ); end condition #1
   ((and lnSet(=(getvar "PEDITACCEPT")1))
    (command "_.pedit" "_m" lnSet "" "_j" "0.0" "")
    ); end condition #2
   ); end cond
   (asmi-LayersStateRestore rLst)
   (setvar "CMDECHO" oldEcho)
   ); end progn
  ); end if
 ); end progn
); end if
 (princ)
 ); end of c:mpl

[VVA]

may be as interested in this link

Advanced Offset to both side

;;; ================================ OFF2 =========================================

;;;

;;; Note : Offset selected object to both side and change (optional) layer of new object to current

 

.............................................................................................................................................

 

;;; ================================ MOFF2 ========================================

;;;

;;; Note : Multi Offset selected object to both side and change (optional) layer of new object to current

 

.............................................................................................................................................

[tzframpton]

Alan(s), David, and VVC.... thanks a million guys. I have exactly what I need. Already made a custom icon for it, and set some macros for each set of piping we'll need, and added it to the ACADDOC.LSP file and Tool Palettes. It is officially apart of the Crawford Mechanical suite of AutoCAD programs.

[BlackBox]

... So the Kick backs are in the mail, ehh?

(I had zero contribution... Just kidding, of course!)

[alanjt]

This may also be of interest: http://www.cadtutor.net/forum/showthread.php?51000-A-different-kind-of-the-offset-command&highlight=Continuous+Offset

[ReMark]

Hey StykMaN! This time make a back up copy! If you lose these routines they're going to have to charge you double dude!

[Lee Mac]

Another, may be of use:

 

http://www.cadtutor.net/forum/showthread.php?48365-i-search-for-offset-with-same-value-and-opposite-direction&p=354750&viewfull=1#post354750

[tzframpton]

Ha, they're already in my Dropbox folder. They are definitely safe this time.