[编程交流] 没有offsetgaptype的偏移，

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

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

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

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