Jump to content

Lisp to create an offset construction line with indefinite length.

stevsmith

By stevsmith
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

stevsmith Veteran

stevsmith

Posted
Posted

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.

Lee Mac Grand Master

Lee Mac

Posted
Posted

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)
)

Lee Mac Grand Master

Lee Mac

Posted
Posted

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.

stevsmith Veteran

stevsmith

Posted
  • Author
Posted

Superb work once again lee.

Exactly what I require.

 

Thanks Bud.

BIGAL Grand Master

BIGAL

Posted
Posted

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.

  • 10 years later...
Abrasive Enthusiast

Abrasive

Posted
Posted (edited)
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

Edited by Tom Matson
exceed Proficient

exceed

Posted
Posted (edited)
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?

Edited by exceed
  • Like 1
mhupp Grand Master

mhupp

Posted
Posted

FYI 

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

 

 

  • Like 1
Abrasive Enthusiast

Abrasive

Posted
Posted
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?

exceed Proficient

exceed

Posted
Posted
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 

Abrasive Enthusiast

Abrasive

Posted
Posted

Hmmm,

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

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...