Lisp to create an offset construction line with indefinite length.

We use the nesting software Tru-Tops to program our laser and punch department and I have notice how handy one of the options on it is. (even though the rest of the program is utter garbage)

When using the CAD software there is an option to create a construction line paralel to a specific line with an infinite length that will erase automatically after closing the drawing. With autocad this can be very annoying to draw a construction line pick 2 points then offset and delete the original construction line.

So. to get to the point. I'm looking to see if one of my friendly lisp'ers out there would be willing to write me a lisp for this.

The sequence should be as follows.

Command start "oset"

Select the line to offset (this will create a construction line with infinite line length paralell to the selected line)

Enter the offset distance. Hit enter to place the line desired distance from the original

Created construction layer will be on " Construction Line" layer.

Thanks in advance.

Stevie.

This uses a slightly different approach, but perhaps it might be useful:

(defun c:oset ( / *error* e orth xl )

 (defun *error* ( msg )
   (if orth (setvar 'ORTHOMODE orth))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (setq orth (getvar 'ORTHOMODE))
 (setvar 'ORTHOMODE 1)
 
 (while
   (progn (setvar 'ERRNO 0) (setq e (car (entsel "\nSelect Line: ")))
     (cond
       ( (= 7 (getvar 'ERRNO))
         (princ "\nMissed, Try Again.")
       )
       ( (eq 'ENAME (type e))
         (if (eq "LINE" (cdr (assoc 0 (setq e (entget e)))))
           (progn
             (setq xl
               (entmakex
                 (list
                   (cons 0 "XLINE")
                   (cons 100 "AcDbEntity")
                   (cons 100 "AcDbXline")
                   (cons 8 "Construction Line")
                   (assoc 10 e)
                   (cons  11
                     (polar '(0. 0. 0.)
                       (angle (cdr (assoc 10 e)) (cdr (assoc 11 e))) 1.
                     )
                   )
                 )
               )
             )
             (command
               "_.ucs" "_OB" (cdr (assoc -1 e))
               "_.move" xl "" "_non"
               (trans (mapcar '(lambda ( a b ) (/ (+ a b) 2.)) (cdr (assoc 10 e)) (cdr (assoc 11 e))) 0 1)
               pause
               "_.ucs" "_P"
             )
           )
           (princ "\nObject must be a Line.")
         )
       )
     )
   )
 )
 (setvar 'ORTHOMODE orth)
 (princ)
)

Here is another possible method, using a coordinate transformation to make the offset easier:

(defun c:oset ( / di ln nm p1 )
 (if
   (and
     (setq ln (ssget "_+.:E:S" '((0 . "LINE"))))
     (setq di (getreal "\nSpecify Offset Distance: "))
   )
   (progn
     (setq ln (entget (ssname ln 0))
           nm (mapcar '- (cdr (assoc 10 ln)) (cdr (assoc 11 ln)))
           p1 (trans (cdr (assoc 10 ln)) 0 nm)
     )
     (entmake
       (list
         (cons 0 "XLINE")
         (cons 100 "AcDbEntity")
         (cons 100 "AcDbXline")
         (cons 8 "Construction Line")
         (cons 10 (trans (list (+ (car p1) di) (cadr p1) (caddr p1)) nm 0))
         (cons 11 (trans '(0. 0. 1.) nm 0))
       )
     )
   )
 )
 (princ)
)

Specify a positive distance to offset to the right of the line, negative for the left.

Superb work once again lee.

Exactly what I require.

Thanks Bud.

Another way to not save anything temporary not limited to xlines then but user must obey layer rules, is to reprogram the "save" "close" commands so you run a delete layer first then a normal save. You can do it easy in the menu's, also in pgp.

You're welcome Stevie

On 7/4/2011 at 9:22 AM, Lee Mac said:

Here is another possible method, using a coordinate transformation to make the offset easier:

 

 

(defun c:oset ( / di ln nm p1 )
 (if
   (and
     (setq ln (ssget "_+.:E:S" '((0 . "LINE"))))
     (setq di (getreal "\nSpecify Offset Distance: "))
   )
   (progn
     (setq ln (entget (ssname ln 0))
           nm (mapcar '- (cdr (assoc 10 ln)) (cdr (assoc 11 ln)))
           p1 (trans (cdr (assoc 10 ln)) 0 nm)
     )
     (entmake
       (list
         (cons 0 "XLINE")
         (cons 100 "AcDbEntity")
         (cons 100 "AcDbXline")
         (cons 8 "Construction Line")
         (cons 10 (trans (list (+ (car p1) di) (cadr p1) (caddr p1)) nm 0))
         (cons 11 (trans '(0. 0. 1.) nm 0))
       )
     )
   )
 )
 (princ)
)

 

Specify a positive distance to offset to the right of the line, negative for the left.

@Lee Mac

I know this an old post....

Could this be modified to select other entities?

Like polylines and other xLines?

I use this now but have changed the di to static values.

I use common offsets and its a pain to have to enter the value every time, but this routine works nicely.

Thanks

Tom

2 hours ago, Tom Matson said:

@Lee Mac

I know this an old post....

Could this be modified to select other entities?

Like polylines and other xLines?

I use this now but have changed the di to static values.

I use common offsets and its a pain to have to enter the value every time, but this routine works nicely.

Thanks

Tom

(vl-load-com)
(defun c:oset ( / di ln nm p1 lno lntype pt1 pt2 polycoord polycoordlen )
 (if
   (and
     (setq ln (ssget "_+.:E:S" '((0 . "*LINE"))))
     (setq di (getreal "\nSpecify Offset Distance: "))
   )
   (progn
     (setq lno (vlax-ename->vla-object (ssname ln 0)))
     (setq lntype (vlax-get-property lno 'EntityName))
     (cond 
       ((= lntype "AcDbLine")
         (setq pt1 (vlax-safearray->list (vlax-variant-value (vlax-get-property lno 'StartPoint))))
         (setq pt2 (vlax-safearray->list (vlax-variant-value (vlax-get-property lno 'EndPoint))))
       )
       ((= lntype "AcDbXline")
         (setq pt1 (vlax-safearray->list (vlax-variant-value (vlax-get-property lno 'BasePoint))))
         (setq pt2 (vlax-safearray->list (vlax-variant-value (vlax-get-property lno 'SecondPoint))))
       )
       ((= lntype "AcDbPolyline")
         (setq polycoord (vlax-safearray->list (vlax-variant-value (vlax-get-property lno 'coordinates))))
         (setq polycoordlen (length polycoord))
         (setq pt1 (list (car polycoord) (cadr polycoord) 0.0))
         (setq pt2 (list (nth (- polycoordlen 2) polycoord) (last polycoord) 0.0))
       )
     )
     (setq nm (mapcar '- pt1 pt2))
     (setq p1 (trans (cdr pt1) 0 nm))
     (entmake
       (list
         (cons 0 "XLINE")
         (cons 100 "AcDbEntity")
         (cons 100 "AcDbXline")
         (cons 8 "Construction Line")
         (cons 10 (trans (list (+ (car p1) di) (cadr p1) (caddr p1)) nm 0))
         (cons 11 (trans '(0. 0. 1.) nm 0))
       )
     )
   )
 )
 (princ)
)

like this?

FYI

(setq pt1 (vlax-safearray->list (vlax-variant-value (vlax-get-property lno 'BasePoint))))
(setq pt1 (vlax-get lno 'BasePoint))

1 hour ago, exceed said:

(vl-load-com)
(defun c:oset ( / di ln nm p1 lno lntype pt1 pt2 polycoord polycoordlen )
 (if
   (and
     (setq ln (ssget "_+.:E:S" '((0 . "*LINE"))))
     (setq di 10 (getreal "\nSpecify Offset Distance: "))
   )
   (progn
     (setq lno (vlax-ename->vla-object (ssname ln 0)))
     (setq lntype (vlax-get-property lno 'EntityName))
     (cond 
       ((= lntype "AcDbLine")
         (setq pt1 (vlax-safearray->list (vlax-variant-value (vlax-get-property lno 'StartPoint))))
         (setq pt2 (vlax-safearray->list (vlax-variant-value (vlax-get-property lno 'EndPoint))))
       )
       ((= lntype "AcDbXline")
         (setq pt1 (vlax-safearray->list (vlax-variant-value (vlax-get-property lno 'BasePoint))))
         (setq pt2 (vlax-safearray->list (vlax-variant-value (vlax-get-property lno 'SecondPoint))))
       )
       ((= lntype "AcDbPolyline")
         (setq polycoord (vlax-safearray->list (vlax-variant-value (vlax-get-property lno 'coordinates))))
         (setq polycoordlen (length polycoord))
         (setq pt1 (list (car polycoord) (cadr polycoord) 0.0))
         (setq pt2 (list (nth (- polycoordlen 2) polycoord) (last polycoord) 0.0))
       )
     )
     (setq nm (mapcar '- pt1 pt2))
     (setq p1 (trans (cdr pt1) 0 nm))
     (entmake
       (list
         (cons 0 "XLINE")
         (cons 100 "AcDbEntity")
         (cons 100 "AcDbXline")
         (cons 8 "Construction Line")
         (cons 10 (trans (list (+ (car p1) di) (cadr p1) (caddr p1)) nm 0))
         (cons 11 (trans '(0. 0. 1.) nm 0))
       )
     )
   )
 )
 (princ)
)

 

like this?

Getting an Invalid parameter?

Just now, Tom Matson said:

Getting an Invalid parameter?

change 

(setq di 10 (getreal "\nSpecify Offset Distance: "))

to 

(setq di (getreal "\nSpecify Offset Distance: "))

maybe this point 

Hmmm,

Its actually taking the (end X) - (end Y)  - (typed offset value) = offset