Changing the justification/dragline of my Pipe routine

[egjg1234]

Hello guys!

New to the forum but have been looking at this forum for help for a few years now and has been very helpful for my auto cad education and career!

I have this lisp routine that creates a pline in each side of the original pline to create this stormwater pipe. I've been trying to figure out how I can start the offset from the bottom line instead of the middle pline to no avail. Is there anyone that help me with this? 

Changing the justification of the dragline could save me hours creating details for work. 

Thanks a bunch!

 

; STORMWATER.LSP


(defun c:SWPIPE  () ;(/ PT PT1 PT2 WID ELAST KTEMP E1 E2 ang1 ang2)
  (setvar "CMDECHO" 0)
  (initget 1)
  (setq PT (getpoint "\nStart point: "))
  (command ".PLINE" PT "W" 0 0)
  (setq PT1 PT PT0 PT)
  (while (setq PT (getpoint PT "\nNext point: "))
    (setq PT2 PT)
    (command PT)
  )
  (setq ang1 (-(angle pt1 pt2)(/ pi 2)) ang2 (+ ang1 pi))
  (command)
(SETQ OS (GETVAR "OSMODE"))
(setvar "osmode" 0)
  (initget 4)
  (setq ELAST (entlast)
        KTEMP (getdist "\nLine width<0.0>:")
        WID ktemp
;        WID   (* (if KTEMP KTEMP 0.0416) (GetVar "LTSCALE"));old UserR1
;        PT1   (reverse (cdr (reverse PT1)))
  )
  (command ".OFFSET" (/ WID 2) (list ELAST PT1)
                     (polar PT1 ang1 0.1)"")
  (setq E1 (entlast))
  (command ".OFFSET"(/ WID 2) (list ELAST PT1)
                    (polar PT1 ang2 0.1) "")
  (setq E2 (entlast))
  (command ".PEDIT" ELAST "W" WID "" ".CHANGE" ELAST"" "P" "LT" "HIDDEN1" "")
  (redraw E1) (redraw E2)
  (princ)S
(setvar "osmode" 0)
  )

 

SWPIPE.LSP

Edited December 10, 2020 by SLW210
Added Code Tags

[Jonathan Handojo]

Just out of my generosity, this is a function that I use in my workplace to construct civil lines. My original code works by drawing the center line (just like the one in OP), but I tweaked it to suit your needs.

 

;; dashed:bottom --> Jonathan Handojo
;; Draws a polyline of a certain width at a certain layer, and makes two offsets of that polyline at that width. Center line at bottom justification.
;; Arguments:
;; wid1 - the center polyline width -> if 'nil', user will be prompted the polyline width
;; wid2 - the edge polyline width -> if 'nil', user will be prompted the polyline width
;; lay1 - the layer of the center polyline -> if 'nil', current layer will be used
;; lay2 - the layer of the edge polyline -> if 'nil', current layer will be used
;; ortho - 'T' or 'nil'
;;	=> use 'T' to set orthomode active
;;	=> use 'nil' to set orthomode inactive
;; The polyline's linetype and color will inherit that of the layers' linetype

(defun swd:bottom (wid1 wid2 lay1 lay2 ortho / *error* acadobj activeundo adoc allpts cenpl endpt halfwid msp objs orth pt rtn todel)
    
    (defun *error* ( msg )	; <--- in the case the user presses the Escape button to escape the command, this function will activate
				; <--- this takes one argument 'msg' which is the error message
	(if todel (mapcar 'entdel todel))
	(if orth (setvar 'autosnap orth))
	(vla-EndUndoMark adoc)
	(if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
	    (princ (strcat "Error: " msg))
	    )
	)
    (setq acadobj (vlax-get-acad-object)
	  adoc (vla-get-ActiveDocument acadobj)
	  msp (vla-get-ModelSpace adoc)
	  activeundo nil)
    (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))

    (if	; if ...
	(= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))	; ... the current layer is locked, then ...
	(alert "\nPlease unlock the current layer before proceeding.")		; ... alert the user that the layer is locked ...
	(progn	; ... otherwise ...

	    (if (null wid1) (setq wid1 (progn (initget 5) (getdist "\nSpecify center polyline width: "))))
	    (if (null wid2) (setq wid2 (progn (initget 5) (getdist "\nSpecify edge polyline width: "))))
	    (if (null lay1) (setq lay1 (getvar 'clayer)))
	    (if (null lay2) (setq lay2 (getvar 'clayer)))
	    (setq orth (getvar 'autosnap))
	    (if ortho (setvar 'orthomode 1) (setvar 'orthomode 0))
	    (while
		(setq pt
			 (eval
			     (append
				 '(getpoint)
				 (if
				     (car rtn)
				     (read (strcat "('" (vl-prin1-to-string (car rtn)) ")"))
				     )
				 (if (car rtn)
				     '("\nSpecify next point <exit>: ")
				     '("\nSpecify first point <exit>: ")
				     )
				 )
			     )
		      )
		(setq rtn (cons pt rtn))
		(if (setq endpt (cadr rtn))
		    (setq todel
			     (cons
				 (entmakex (list '(0 . "LINE") '(62 . 1) '(6 . "Continuous") (cons 10 endpt) (cons 11 (car rtn))))
				 todel
				 )
			  )
		    )
		)

	    (mapcar 'entdel todel)
	    (if (>= (length (setq rtn (reverse rtn))) 2)
		(progn
		    (setq
			allpts
			   (mapcar
			       '(lambda (x)
				    (list
					(cons 10 x)
					(cons 40 wid1)
					(cons 41 wid1)
					'(42 . 0.0)
					'(91 . 0.0)
					)
				    )
			       rtn
			       )
			cenpl
			   (vlax-ename->vla-object
			       (entmakex
				   (append
				       (list
					   '(0 . "LWPOLYLINE")
					   '(100 . "AcDbEntity")
					   '(67 . 0)
					   '(100 . "AcDbPolyline")
					   '(6 . "ByLayer")
					   (cons 90 (length rtn))
					   '(70 . 0)
					   (cons 43 wid2)
					   '(62 . 256)
					   )
				       (apply 'append allpts)
				       )
				   )
			       )
			halfwid (* 0.5 wid1)
			)

		    (mapcar
			'(lambda (x y z)
			     (setq objs (vlax-invoke cenpl 'Offset x))
			     (vla-put-ConstantWidth (car objs) y)
			     (vla-put-Linetype (car objs) "ByLayer")
			     (entmod
				 (subst
				     (cons 8 z)
				     (assoc 8 (entget (vlax-vla-object->ename (car objs))))
				     (entget (vlax-vla-object->ename (car objs)))
				     )
				 )
			     )
			(list (- halfwid) (- wid1))
			(list wid1 wid2)
			(list lay1 lay2)
			)
		    
		    (entmod
			(subst
			    (cons 8 lay2)
			    (assoc 8 (entget (vlax-vla-object->ename cenpl)))
			    (entget (vlax-vla-object->ename cenpl))
			    )
			)
		    )
		)
	    (setvar 'autosnap orth)
	    )
	)
    (if activeundo nil (vla-EndUndoMark adoc))
    (princ)
    )

 

Just so that, instead of recording macros, I do this as example:

 

(defun c:swd100 nil (swd:bottom 100 0 "H-SWD2" "Prefab Text" T))
(defun c:swd150 nil (swd:bottom 150 0 "H-SWD2" "Prefab Text" T))
(defun c:swdopt nil (swd:bottom nil nil nil "Prefab Text" nil))

 

[egjg1234]

Thanks  for the quick reply and thanks for providing the original lisp routine! It works like magic!

Another, request is there a way to specify the linetype of the centreline while keeping the layer the same? 

I'm still a beginner in lisp routine creation but im sure ill get to your level sometime in the future!

Thanks again!

9 hours ago, Jonathan Handojo said:

enter polyline width -> if 'nil', user will be prompted the polyline width ;; wid2 - the edge polyline wi