Looking for a LISP routine: Multiple Polyline Offset

Hey everyone, looking for some help here. I have been searching for a half hour but no luck. I seem to recall a program that someone made that operates like the MLINE tool, but just with normal polylines. I have done some searching over at The Swamp as well, and I can't find it.

 

I want MLINE functionality but I just don't want to deal with the hassle of setting up MLSTYLE's etc, I just want to initiate the program, input how many plines and what the offset is and draw. Wasn't there something like this that existed? I thought I saved it a long time ago but when I searched through my collection of downloads, no dice. Any help would be appreciated. Thanks again in advance!!

 

- Tannar

Is this what you were looking for?

 

http://www.cadtutor.net/forum/showthread.php?9434-Multiple-Offset

Mark, Thanks for the help but that works like the normal offset command. I'm wanting the multiple offset polylines to be active as I'm drawing.

I'm wanting the multiple offset polylines to be active as I'm drawing.

 

 

Do you mean, that once you offset a line, the resultant line is now the 'active' line to be offset?

 

If not, please clarify.

Sorry for my lack of clarification. Here's is exactly how the program worked that I found in the past:

 

1. You initiate the program, and it asks for two initial criteria: the distance of the offset, and how many lines you want.

 

2. You draw as if you were routing a single PLINE in your drawing, but as you draw the predetermined number of polylines will also be drawn, all at the offset distance that was preset by the user.

 

Works exactly like the MLINE command, except no hassle in setting up MSTYLE's before you start drawing to get the proper offsets you want.

No worries.

 

Had my speculation been correct, I could have easily revised some existing code.

 

Good luck!

Sorry for my lack of clarification. Here's is exactly how the program worked that I found in the past:

 

1. You initiate the program, and it asks for two initial criteria: the distance of the offset, and how many lines you want.

 

 

Tanner, It is definitely doable.

 

Are all there any bulges ( arcs ) segments?

Are all of the lytypes bylayer?

Is everything 2D geometry?

Is the number of offset equal for both sides?

 

-David

David,

 

- No arcs or radius corners, all mitered.

- ByLayer is fine, it'll be going on a pre-existing M-PIPE layer.

- Everything 2D

- Yes, the offset should be consistent with every PLINE.

 

I'm not asking for someone to write one, this program does exist, I'm just trying to dig it up. I can't believe I didn't save it when I saw it a couple of years ago. It's just to show mechanical piping routing from mechanical units in an architectural plan. I'll be utilizing the Tool Palettes in conjunction with this program. It's just a hassle to use MLINEs because you have to create styles which takes time, then explode them to break the crossing lines, etc.

Here is what I do when I get in the fix that you're in

 

Doe you have a file mangement program ( XTREE ZTREE ) that can search multpile files for text?

Filter only .lsp files

Search for terms that you remember in the prompts. In this case 'offset 'quantity

Maybe 'M-PIPE if the program set it to the layer

Maybe 'grdraw if it drew phantom lines as the user input was collected

 

If I get down to 10 or so files then I'll open view each one to see if I can find it that way.

 

I have 2,000+ routines and I am getting long in the tooth so I get in that pinch fairly often.

 

But in the end it is not hard to redo it. -David

Seems you've been over this same ground before (2007).

 

http://www.cadtutor.net/forum/archive/index.php/t-15686.html

Seems you've been over this same ground before (2007).

 

http://www.cadtutor.net/forum/archive/index.php/t-15686.html

Ha, yup. 3 years ago, man that's a long time. 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). I really wish I could find that old program, it was freaking perfect man.

When you draw your line, are the offset(s) on both sides or a defined right/left side?

If I had to choose, I would make the offsets on both sides, keeping the routing of each point as the centerline.

This thread?

 

http://www.cadtutor.net/forum/showthread.php?49301-Any-function-to-draw-Lines-instead-of-Mline&p=335931&viewfull=1#post335931

This was an interesting 1:

 

 

;=======================================================================
;    QMLine.Lsp                                    Sep 28, 2010
;    Multi Line With Quantity And Distance Inputs
;================== Start Program ======================================
(princ "\nCopyright (C) 1990-2010, Fabricated Designs, Inc.")
(princ "\nLoading QMLine v1.0 ")

;++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun qml_smd ()
(SetUndo)
(setq olderr *error*
     *error* (lambda (msg)
               (while (> (getvar "CMDACTIVE") 0)
                      (command))
               (and (/= msg "quit / exit abort")
                    (princ (strcat "\nError: *** " msg " *** ")))
               (and (= (logand (getvar "UNDOCTL")  8)
                    (command "_.UNDO" "_END" "_.U"))
               (qml_rmd))
      qml_var '(("OSMODE"    . 0) ("SORTENTS"   . 119)
                ("LUPREC"    . 2) ("BLIPMODE"  . 0)
                ("SNAPMODE"  . 1) ("ORTHOMODE" . 1)
                ("UCSICON"   . 1) ("HIGHLIGHT" . 1)
                ("COORDS"    . 2) ("DIMZIN"    . 1)
                ("CMDECHO"   . 0)
                ("CECOLOR"   . "BYLAYER")
                ("CELTYPE"   . "BYLAYER")))
(foreach v qml_var
  (and (getvar (car v))
       (setq qml_rst (cons (cons (car v) (getvar (car v))) qml_rst))
       (setvar (car v) (cdr v))))
(princ (strcat (getvar "PLATFORM") " Release " (ver)))
(princ))

;++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun qml_rmd ()
 (setq *error* olderr)
 (foreach v qml_rst (setvar (car v) (cdr v)))
 (command "_.UNDO" "_END")
 (prin1))

;++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
(and (zerop (getvar "UNDOCTL"))
     (command "_.UNDO" "_ALL"))
(and (= (logand (getvar "UNDOCTL") 2) 2)
     (command "_.UNDO" "_CONTROL" "_ALL"))
(and (= (logand (getvar "UNDOCTL")  8)
     (command "_.UNDO" "_END"))
(command "_.UNDO" "_GROUP"))

;++++++++++++ GrDraw A Point List ++++++++++++++++++++++++++++++++
(defun grpl (l c f / tmp)
 (setq tmp l)
 (while (> (length tmp) 1)
        (grdraw (car tmp) (cadr tmp) c f)
        (setq tmp (cdr tmp))))

;;;ARG -> POINT_LIST   OFFSET_DISTANCE   OFFSET_SIDE ("Inside" "Outside")
(defun offset (pl of side / p1 p2 p3 p4 cls_flag ccw cw
                           tmp ol pi05 func v1 ipt nl)

;;;CCW TEST - FROM COMPUSERVE DAYS
;;;ARG -> POINT_LIST
;;;RET -> POSITIVE = CCW    NEGATIVE = CW
(defun surf (lst / sum i)
  (setq i 0 sum 0)
  (while (< i (- (length lst) 1))
         (setq sum (+ sum (- (* (car (nth i lst))  (cadr (nth (+ 1 i) lst)))
                             (* (cadr (nth i lst)) (car  (nth (+ 1 i) lst))))))
     (setq i (1+ i)))
  (/ sum 2.0))

  (setq cls_flag (if (equal (car pl) (last pl) 1e- T nil))
  (if (minusp (surf pl)) (setq cw T) (setq ccw T))
  (cond ((and ccw (= side "Inside"))  (setq func +))
        ((and cw  (= side "Inside"))  (setq func -))
        ((and ccw (= side "Outside")) (setq func -))
        ((and cw  (= side "Outside")) (setq func +)))

  (setq tmp pl ol nil pi05 (* pi 0.5))
  (while (> (length tmp) 2)
         (setq p1 (polar (nth 0 tmp)
                  (func (angle (nth 0 tmp) (nth 1 tmp)) pi05) of))
         (setq p2 (polar (nth 1 tmp)
                  (func (angle (nth 0 tmp) (nth 1 tmp)) pi05) of))
         (setq p3 (polar (nth 1 tmp)
                  (func (angle (nth 1 tmp) (nth 2 tmp)) pi05) of))
         (setq p4 (polar (nth 2 tmp)
                  (func (angle (nth 1 tmp) (nth 2 tmp)) pi05) of))
         (and (not v1)
              (not cls_flag)
              (setq v1 p1 ol (list v1)))
         (setq ipt (inters p1 p2 p3 p4 nil))
         (and ipt
              (setq ol (cons ipt ol)))
         (setq tmp (cdr tmp)))

(and (not cls_flag)
     (setq ol (cons p4 ol)))

(and cls_flag
    (setq nl (- (length pl) 2))
    (setq p1 (polar (nth nl pl)
             (func (angle (nth nl pl) (nth 0 pl)) pi05) of))
    (setq p2 (polar (nth 0 pl)
             (func (angle (nth nl pl) (nth 0 pl)) pi05) of))
    (setq p3 (polar (nth 0 pl)
             (func (angle (nth 0 pl) (nth 1 pl)) pi05) of))
    (setq p4 (polar (nth 1 pl)
             (func (angle (nth 0 pl) (nth 1 pl)) pi05) of))
    (setq ipt (inters p1 p2 p3 p4 nil))
    (and ipt
         (setq ol (cons ipt ol))
         (setq ol (append ol (list ipt)))))
ol)

;************ Main Program ***************************************
(defun qml_ (/ olderr qml_var qml_rst odef o qdef q np pl r c)
 (qml_smd)
;  (*-debug-* 9 "qml_")

;;;OFFSET DISTANCE
 (setq odef (if db_ofd db_ofd 2))
 (initget 6)
 (setq o (getdist (strcat "\nOffset Distance <" (rtos odef 2 2) ">:   ")))
 (if (not o)
     (setq o odef))
 (setq db_ofd o)

;;;OFFSET QTY
 (setq qdef (if db_ofq db_ofq 2))
 (initget 6)
 (setq q (getint (strcat "\nNumber Of Offset Lines Per Side <" (itoa qdef) ">:   ")))
 (if (not q)
     (setq q qdef))
 (setq db_ofq q)

;;:GET POINTS
 (initget 1)
 (setq np (getpoint "\n1st Point:   "))
 (setq pl (list np))
 (while (setq np (getpoint np "\nNext Point:   "))
        (setq pl (cons np pl))
        (grpl pl 2 3)
        (setq r 1 c 1)
        (repeat q
          (set (read (strcat "R" (itoa r)))
               (offset pl (* o c) "Inside"))
          (set (read (strcat "R" (itoa (1+ r))))
               (offset pl (* o c) "Outside"))
          (setq c (1+ c))
          (grpl (cdr (reverse (eval (read (strcat "R" (itoa r)))))) 1 3)
          (grpl (cdr (reverse (eval (read (strcat "R" (itoa (1+ r))))))) 3 3)           (setq r (+ r 2))))

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

;;;OFFSET LINES
 (setq r 1)
 (repeat q
    (command "_.PLINE")
      (foreach p (eval (read (strcat "R" (itoa r))))
             (command p))
    (command "")
    (command "_.PLINE")
      (foreach p (eval (read (strcat "R" (itoa (1+ r)))))
             (command p))
    (command "")
    (setq r (+ r 2)))

;;;CLEAR DYNAMIC POINT LISTS
 (setq r 1)
 (repeat q
   (set (read (strcat "R" (itoa r))) nil)
   (set (read (strcat "R" (itoa (1+ r)))) nil)
   (setq r (+ r 2)))

;  (*break*)
;  (*-debug-* 0 "qml_")
 (qml_rmd))

;************ Load Program ***************************************
(defun C:QMLine () (qml_))
(if qml_ (princ "\nQMLine Loaded\n"))
(prin1)
;|================== End Program =======================================

 

If the first point and last points are coincidental, it should fillet and close th loop. -David

I cheated, but here's my contribution...

 

(defun c:OD (/ _draw _eq lwp)
 ;; Offset Draw
 ;; Required subroutines: AT:GetPoints
 ;; Alan J. Thompson, 09.28.10

 (vl-load-com)

 (defun _draw (lst / lst gen)
   (if (vl-consp lst)
     (progn
       (if (_eq (car lst) (last lst))
         (setq lst (reverse (cdr (reverse lst)))
               gen (+ (* (getvar 'plinegen) 128) 1)
         )
         (setq gen (* (getvar 'plinegen) 128))
       )
       (vlax-ename->vla-object
         (entmakex
           (append
             (list '(0 . "LWPOLYLINE")
                   '(100 . "AcDbEntity")
                   '(100 . "AcDbPolyline")
                   (cons 90 (length lst))
                   (cons 70 gen)
             )
             (mapcar (function (lambda (p) (cons 10 (reverse (cdr (reverse (trans p 1 0))))))) lst)
           )
         )
       )
     )
   )
 )

 (defun _eq (a b) (equal (list (car a) (cadr a)) (list (car b) (cadr b))))


 (initget 6)
 (setq *OD:Off* (cond ((getdist (strcat "\nSpecify offset distance <"
                                        (rtos (cond (*OD:Off*)
                                                    ((setq *OD:Off* 1.))
                                              )
                                        )
                                        ">: "
                                )
                       )
                      )
                      (*OD:Off*)
                )
 )
 (initget 6)
 (setq *OD:Num* (cond ((getint (strcat "\nSpecify number of offsets <"
                                       (itoa (cond (*OD:Num*)
                                                   ((setq *OD:Num* 1))
                                             )
                                       )
                                       ">: "
                               )
                       )
                      )
                      (*OD:Num*)
                )
 )

 (if (setq lwp (_draw (AT:GetPoints)))
   ((lambda (i)
      (repeat *OD:Num*
        (setq i (1+ i))
        (mapcar
          (function (lambda (d) (vl-catch-all-apply (function vla-offset) (list lwp (* i d)))))
          (list *OD:Off* (- *OD:Off*))
        )
      )
    )
     0.
   )
 )
 (princ)
)



(defun AT:GetPoints (/ lst pt)
 ;; Return list of picked points
 ;; Alan J. Thompson, 06.18.10
 (if (car (setq lst (list (getpoint "\nSpecify first point: "))))
   (progn
     (while (and (if (> (length lst) 2)
                   (setq pt (initget 0 "Close")
                         pt (getpoint (car lst) "\nSpecify next point [Close]: ")
                   )
                   (setq pt (getpoint (car lst) "\nSpecify next point: "))
                 )
                 (/= pt "Close")
            )
       (mapcar (function (lambda (a b) (and a b (grdraw a b 1 1))))
               (setq lst (cons pt lst))
               (cdr lst)
       )
     )
     (redraw)
     (if (> (length lst) 1)
       (reverse (cond ((= pt "Close") (cons (last lst) lst))
                      (lst)
                )
       )
     )
   )
 )
)

This thread?

 

http://www.cadtutor.net/forum/showthread.php?49301-Any-function-to-draw-Lines-instead-of-Mline&p=335931&viewfull=1#post335931

Lee, I think that might have been the thread, but I still want to see I remember something that was more than just two PLINES. I'm pretty sure....

 

This was an interesting 1:

 

If the first point and last points are coincidental, it should fillet and close the loop. -David

 

I cheated, but here's my contribution...

David/Alan, these are both exactly what I wanted, on the mark. It's funny because now I have used each of y'alls program, I realize with my initial clarification, this creates the program to always have a centerline which means the offsets increment in odd numbers. The lowest amount of PLINES it creates is 3 because if you use an offset distance of one, it creates two offset PLINES along with the center. 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. Meh, no worries, its easier just to delete one PLINE to get what I need. It seems it would be too much trouble to re-write these programs. It already gets me way ahead of the game. It's only for schematic layout of mechanical piping in plan view, so it doesn't have to be spectacular.

 

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". What I need to do is get some authorization to pay one of y'all to build a complete custom suite that fits our company needs and standards.

 

Anyways, I always feel humiliated like I'm asking for a freebie and most of y'all have always helped me out and I undoubtedly appreciate it. I can't help but to always feel in debt to the few of you who have always lent a hand with some LISP help.

 

- Tannar

A simple addition...

 

(defun c:OD (/ _draw _eq lwp)
 ;; Offset Draw
 ;; Required subroutines: AT:GetPoints
 ;; Alan J. Thompson, 09.28.10

 (vl-load-com)

 (defun _draw (lst / lst gen)
   (if (vl-consp lst)
     (progn
       (if (_eq (car lst) (last lst))
         (setq lst (reverse (cdr (reverse lst)))
               gen (+ (* (getvar 'plinegen) 128) 1)
         )
         (setq gen (* (getvar 'plinegen) 128))
       )
       (vlax-ename->vla-object
         (entmakex
           (append
             (list '(0 . "LWPOLYLINE")
                   '(100 . "AcDbEntity")
                   '(100 . "AcDbPolyline")
                   (cons 90 (length lst))
                   (cons 70 gen)
             )
             (mapcar (function (lambda (p) (cons 10 (reverse (cdr (reverse (trans p 1 0))))))) lst)
           )
         )
       )
     )
   )
 )

 (defun _eq (a b) (equal (list (car a) (cadr a)) (list (car b) (cadr b))))


 (initget 6)
 (setq *OD:Off* (cond ((getdist (strcat "\nSpecify offset distance <"
                                        (rtos (cond (*OD:Off*)
                                                    ((setq *OD:Off* 1.))
                                              )
                                        )
                                        ">: "
                                )
                       )
                      )
                      (*OD:Off*)
                )
 )
 (initget 6)
 (setq *OD:Num* (cond ((getint (strcat "\nSpecify number of offsets <"
                                       (itoa (cond (*OD:Num*)
                                                   ((setq *OD:Num* 1))
                                             )
                                       )
                                       ">: "
                               )
                       )
                      )
                      (*OD:Num*)
                )
 )

 (initget 0 "Yes No")
 (setq *OD:Del* (cond ((getkword (strcat "Delete middle line? [Yes/No] <"
                                         (cond (*OD:Del*)
                                               ((setq *OD:Del* "Yes"))
                                         )
                                         ">: "
                                 )
                       )
                      )
                      (*OD:Del*)
                )
 )

 (if (setq lwp (_draw (AT:GetPoints)))
   ((lambda (i)
      (repeat *OD:Num*
        (setq i (1+ i))
        (mapcar
          (function (lambda (d) (vl-catch-all-apply (function vla-offset) (list lwp (* i d)))))
          (list *OD:Off* (- *OD:Off*))
        )
      )
      (and (eq *OD:Del* "Yes") (vl-catch-all-apply (function vla-delete) (list lwp)))
    )
     0.
   )
 )
 (princ)
)



(defun AT:GetPoints (/ lst pt)
 ;; Return list of picked points
 ;; Alan J. Thompson, 06.18.10
 (if (car (setq lst (list (getpoint "\nSpecify first point: "))))
   (progn
     (while (and (if (> (length lst) 2)
                   (setq pt (initget 0 "Close")
                         pt (getpoint (car lst) "\nSpecify next point [Close]: ")
                   )
                   (setq pt (getpoint (car lst) "\nSpecify next point: "))
                 )
                 (/= pt "Close")
            )
       (mapcar (function (lambda (a b) (and a b (grdraw a b 1 1))))
               (setq lst (cons pt lst))
               (cdr lst)
       )
     )
     (redraw)
     (if (> (length lst) 1)
       (reverse (cond ((= pt "Close") (cons (last lst) lst))
                      (lst)
                )
       )
     )
   )
 )
)

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

Also an extra we wrote an auto measure so if you come in tomorow you don't have to remember width settings from day before, just drag a line over what you have drawn previously measure the offsets sq and in your case also how many you need to create. This could be added to alanjt's as an option when asking for widths etc.

 

Nice thing is just have some preset examples in your drawing floating around or bring into drawing a block containing line answers.

 

Anyway you should be able to pull this apart have a look at the date 1993!

;;;---------------------------------------------------------------------------;4
;;;
;;;  
;;  
;;;   by Alan
;;;   1 june 1993
;;;   
;;;  DESCRIPTION
;;;  measure wall by dragging across sets w2 w3 w4 
;
;;;---------------------------------------------------------------------------;
;;;---------------------------------------------------------------------------;
;;; Main Program.
;;;---------------------------------------------------------------------------;
(setvar "cmdecho" 0)
(defun cal_ang_pt ()
(while (setq en (ssname ss 0))
 (setq pt3 (cdr (assoc 10 (entget en))))      
 (setq pt4 (cdr (assoc 11 (entget en))))      
 (setq pt5 (inters pt1 pt2 pt3 pt4 nil))
 (setq dist (distance pt1 pt5))
 (command "line" pt1 "perp" pt5 "")
 (command "erase" "Last" "")
 (setq pt6 (getvar "lastpoint"))
 (setq sss (cons pt6 sss))
 (ssdel en ss)                   
)
)

(setq pt1 (getpoint "\nPick first point on inside of wall :"))
(setq pt2 (getpoint pt1 "\nPick second point on outside of wall :"))

(setq ss (ssget "F" (list pt1 pt2))) 

(defun sort_pts ()
(setq dimno (length sss))
(setq I 0)                      
(setq maxx (- dimno 1))
(while (/= I maxx)                      
(setq j0 pt1)
(setq J 1)
(setq K (- dimno I) )
   (while (/= J K)                    
  (setq j3 (LIST 1 1 1))
  (setq j4 (LIST 2 2 2))
  (setq j2 (nth J sss)) 
  (setq L (- j 1))
  (setq j1 (nth L sss))
  (if (<= (distance j0 j2) (distance j0 j1))       
  (progn
  (setq temp j2)
  (setq temp2 j1)
  (setq sss (subst j3 j2 sss))   
  (setq sss (subst j4 j1 sss))   
  (setq sss (subst J2 j4 sss))   
  (setq sss (subst J1 j3 sss))  
  )
  )
   (setq j (1+ j))
   )                               
(setq i (+ I 1))
)
)
; if sss exists rub it out
(if (/= sss nil)(setq sss nil))
(if (/= ss nil)(setq sss nil))
(cal_ang_pt)
(sort_pts)
(setq pt6 (nth 0 sss))      
; inner skin
(setq pt7 (nth 1 sss))
; second inner
(cond
((= ex_wall 1)
 (setq pt8 (nth 2 sss))     
; outside cav
 (setq pt9 (nth 3 sss))     
; outside skin
 (setq w2 (distance pt6 pt7))
 (setq w3 (distance pt7 pt8))
 (setq w4 (distance pt8 pt9))
 (setvar "userr2" w2)
 (setvar "userr3" w3)
 (setvar "userr4" w4)
 (setq ans (strcat "Walls now set to " (rtos w2) " " (rtos w3) " " (rtos w4)))
)
((= ex_wall 2)
 (setq w5 (distance pt6 pt7))
 (setvar "userr5" w5)
 (setq ans (strcat "Walls now set to " (rtos w5)))
)
((= ex_wall 3)
 (setq w1 (distance pt6 pt7))
 (setvar "userr1" w1)
 (setq ans (strcat "Walls now set to " (rtos w1)))
)
)
(princ "\n")
(princ ans)
(setq *error* olderr)               
(setq ss nil)
(setq sss nil)
(setq pt1 nil)
  pt2 nil
  pt3 nil
  pt4 nil
  pt5 nil
  pt6 nil
  pt7 nil
  pt8 nil
  pt9 nil)
  j1 nil
  j2 nil
  j3 nil
  j4 nil
  ang1 nil
  ang2 nil
  ang3 nil)
(princ)