Offset without offsetgaptype, leaving the corners opened.

[dexus]

Hi Everybody,

 

I'm looking for a way to offset a polyline without changing the lenght of the segments.

I looked into offsetgaptype, but the option to not close the gap isn't one of them.

 

Below is an example of what I want, the pink segments should be removed:

 

I don't mind writing some code myself, but I have no idea how to offset the segments separately or how to figure out which side was chosen.

 

Any help is greatly appreciated.

[alanjt]

Quick and dirty example...

 

(defun c:OAS (/ dst ent pnt obj p1 p2 lst)
 ;; http://www.cadtutor.net/forum/showthread.php?98338-Offset-without-offsetgaptype-leaving-the-corners-opened.


 (initget 6)
 (if (and (setq dst (getdist "\nSpecify offset distance: "))
          (setq ent (car (AT:GetSel entsel
                                    "\nSelect LWPolyline to offset all segments without connecting: "
                                    (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "LWPOLYLINE"))
                         )
                    )
          )
          (setq pnt (getpoint "\nSpecify point on side to offset: "))
          (setq obj (vlax-ename->vla-object ent)
                pnt (trans pnt 1 0)
                p1  (vlax-curve-getclosestpointtoprojection ent pnt '(0 0 1))
          )
          (setq p2 (cond
                     ((vlax-curve-getPointAtDist ent (+ (vlax-curve-getDistAtPoint ent p1) 0.00001)))
                     ((vlax-curve-getPointAtDist ent (- (vlax-curve-getDistAtPoint ent p1) 0.00001)))
                   )
          )
          (setq dst (if (minusp (- (* (- (car p2) (car p1)) (- (cadr pnt) (cadr p1)))
                                   (* (- (cadr p2) (cadr p1)) (- (car pnt) (car p1)))
                                )
                        )
                      (- dst)
                      dst
                    )
          )
          (setq lst (vlax-invoke (vlax-ename->vla-object ent) 'Explode))
     )
   (foreach o lst
     (vla-offset
       o
       (if (and (eq (vla-get-objectname o) "AcDbArc")
                (> (vla-get-startangle o) pi)
           )
         (- dst)
         dst
       )
     )
     (vla-delete o)
   )
 )
 (princ)
)



(defun AT:GetSel (meth msg fnc / ent)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (while
   (progn (setvar 'ERRNO 0)
          (setq ent (meth (cond (msg)
                                ("\nSelect object: ")
                          )
                    )
          )
          (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                ((eq (type (car ent)) 'ENAME)
                 (if (and fnc (not (fnc ent)))
                   (princ "\nInvalid object!")
                 )
                )
          )
   )
 )
 ent
)

[dexus]

Wow, that works really well. Thanks!

 

I understand what happens with the exploding and the loop offsetting all the items,

but how does it know which side to offset?

[dexus]

Just for anyone else who is interested, I changed the code so it gets the last used offset distance from the default offset command (and changes it) and it now offsets to the current layer:

(defun c:OAS (/ dst ent pnt obj p1 p2 lst clayer)
   (initget 6)
   [color=red](setq clayer (getvar "clayer"))[/color]
   (if (and
      [color=red](if (setq dst (getdist (strcat "\nSpecify Offset Distance or <" (rtos (abs (getvar 'Offsetdist)) 2 4) ">: ")))
             (setvar 'Offsetdist dst)
             (setq dst (abs (getvar 'Offsetdist)))
          )[/color]
          (setq ent (car (AT:getsel entsel "\nSelect LWPolyline to offset all segments without connecting: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "LWPOLYLINE")))))
          (setq pnt (getpoint "\nSpecify point on side to offset: "))
          (setq obj (vlax-ename->vla-object ent)
                pnt (trans pnt 1 0)
                p1  (vlax-curve-getclosestpointtoprojection ent pnt '(0 0 1))
          )
          (setq p2 (cond
                     ((vlax-curve-getPointAtDist ent (+ (vlax-curve-getDistAtPoint ent p1) 0.00001)))
                     ((vlax-curve-getPointAtDist ent (- (vlax-curve-getDistAtPoint ent p1) 0.00001)))
                   )
          )
          (setq dst (if (minusp (- (* (- (car p2) (car p1)) (- (cadr pnt) (cadr p1)))
                                   (* (- (cadr p2) (cadr p1)) (- (car pnt) (car p1)))
                                )
                        )
                      (- dst)
                      dst
                    )
          )
          (setq lst (vlax-invoke (vlax-ename->vla-object ent) 'Explode))
     )
   (foreach o lst
     (vla-offset
       o
       (if (and (eq (vla-get-objectname o) "AcDbArc")
                (> (vla-get-startangle o) pi)
           )
         (- dst)
         dst
       )
     )
     [color=red](vla-put-layer (vlax-EName->vla-Object (entlast)) clayer)[/color]
     (vla-delete o)
   )
 )
 (princ)
)

(defun AT:getsel (meth msg fnc / ent)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (while
   (progn (setvar 'ERRNO 0)
          (setq ent (meth (cond (msg)
                                ("\nSelect object: ")
                          )
                    )
          )
          (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                ((eq (type (car ent)) 'ENAME)
                 (if (and fnc (not (fnc ent)))
                   (princ "\nInvalid object!")
                 )
                )
          )
   )
 )
 ent
)

[alanjt]

Wow, that works really well. Thanks!

 

I understand what happens with the exploding and the loop offsetting all the items,

but how does it know which side to offset?

 

See noted code.

(setq pnt (getpoint "\nSpecify point on side to offset: ")) ; pick point on side to offset
(setq obj (vlax-ename->vla-object ent)
     pnt (trans pnt 1 0)
     p1  (vlax-curve-getclosestpointtoprojection ent pnt '(0 0 1)) ; get point on polyline closest to picked point 'pnt'
)
(setq p2 (cond
          ((vlax-curve-getPointAtDist ent (+ (vlax-curve-getDistAtPoint ent p1) 0.00001))) ; create 2nd point 0.00001 to left or right
          ((vlax-curve-getPointAtDist ent (- (vlax-curve-getDistAtPoint ent p1) 0.00001))) ; depending on what it can create
        )
)
(setq dst (if (minusp (- (* (- (car p2) (car p1)) (- (cadr pnt) (cadr p1))) ; area of triangle will return
                        (* (- (cadr p2) (cadr p1)) (- (car pnt) (car p1))) ; negative/positive number depending on direction
                     )
             )
           (- dst) ; change vla-offset distance + or - depending on direction
           dst
         )
)

[alanjt]

Mod on your mod...

 

(defun c:OAS (/ dst ent pnt cla obj p1 p2 lst)
 ;; http://www.cadtutor.net/forum/showthread.php?98338-Offset-without-offsetgaptype-leaving-the-corners-opened.

 (initget 6 "Through")
 (setq dst (getdist (strcat "\nOffset Nested\nSpecify offset distance or [Through] <"
                            (if (minusp (getvar 'OFFSETDIST))
                              "Through"
                              (rtos (getvar 'OFFSETDIST))
                            )
                            ">: "
                    )
           )
 )

 (cond ((not dst))
       ((eq (getvar 'OFFSETDIST) dst))
       ((eq dst "Through") (setvar 'OFFSETDIST -1.))
       ((setvar 'OFFSETDIST dst))
 )


 (if (and (setq ent (AT:GetSel entsel
                               "\nSelect LWPolyline to offset all segments without connecting: "
                               (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "LWPOLYLINE"))
                    )
          )
          (setq pnt (getpoint (cadr ent)
                              (if (minusp (getvar 'OFFSETDIST))
                                "\nSpecify through point: "
                                "\nSpecify point on side to offset: "
                              )
                    )
          )
          (setq ent (car ent)
                cla (getvar 'CLAYER)
                obj (vlax-ename->vla-object ent)
                pnt (trans pnt 1 0)
                p1  (vlax-curve-getclosestpointtoprojection ent pnt '(0 0 1))
          )
          (setq p2 (cond
                     ((vlax-curve-getPointAtDist ent (+ (vlax-curve-getDistAtPoint ent p1) 0.00001)))
                     ((vlax-curve-getPointAtDist ent (- (vlax-curve-getDistAtPoint ent p1) 0.00001)))
                   )
          )
          (setq dst (if (minusp (getvar 'OFFSETDIST))
                      (distance (list (car p1) (cadr p1)) (list (car pnt) (cadr pnt)))
                      dst
                    )
                dst (if (minusp (- (* (- (car p2) (car p1)) (- (cadr pnt) (cadr p1)))
                                   (* (- (cadr p2) (cadr p1)) (- (car pnt) (car p1)))
                                )
                        )
                      (- dst)
                      dst
                    )
          )
          (setq lst (vlax-invoke (vlax-ename->vla-object ent) 'Explode))
     )
   (foreach o lst
     (vla-put-layer o cla)
     (vla-offset
       o
       (if (and (eq (vla-get-objectname o) "AcDbArc")
                (> (vla-get-startangle o) pi)
           )
         (- dst)
         dst
       )
     )
     (vla-delete o)
   )
 )
 (princ)
)
(vl-load-com)
(princ)



(defun AT:GetSel (meth msg fnc / ent)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (while
   (progn (setvar 'ERRNO 0)
          (setq ent (meth (cond (msg)
                                ("\nSelect object: ")
                          )
                    )
          )
          (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                ((eq (type (car ent)) 'ENAME)
                 (if (and fnc (not (fnc ent)))
                   (princ "\nInvalid object!")
                 )
                )
          )
   )
 )
 ent
)