Hi,
Here's my way
EDIT: corrected a missing parent.
;;; Polyarc-data
;;; Returns a list of the center, radius and angle of a 'polyarc'.
(defun polyarc-data (bu p1 p2 / ang rad cen area cg)
(setq ang (* 2 (atan bu))
rad (/ (distance p1 p2)
(* 2 (sin ang))
)
cen (polar p1
(+ (angle p1 p2) (- (/ pi 2) ang))
rad
)
)
(list cen (abs rad) ang)
)
;;; Clockwise-p
;;; Returns T if p1 p2 and p3 are clockwise
(defun clockwise-p (p1 p2 p3)
(< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
)
;;; SEG-OFF
;;; Offsets a segment of polyline
(defun c:seg-off (/ space ofdist ent pline normal side
pick-pt param p1 p2 bulge start end
b-data new swid ewid
)
(vl-load-com)
(or *acdoc*
(setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(setq space (if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace *acdoc*)
(vla-get-ModelSpace *acdoc*)
)
)
(or *ofdist* (setq *ofdist* 10.0))
(if (setq
ofdist (getdist
(strcat "\nSpecify offset distance <" (rtos *ofdist*) ">: ")
)
)
(setq *ofdist* ofdist)
(setq ofdist *ofdist*)
)
(while
(and
(setq ent (entsel "\nSelect a polyline segment: "))
(setq pline (vlax-ename->vla-object (car ent)))
(= (vla-get-ObjectName pline) "AcDbPolyline")
(setq normal (vlax-get pline 'Normal))
(setq side (trans (getpoint "\nSpecify a point on offset side: ")
1
normal
)
)
)
(setq pick-pt (trans (osnap (cadr ent) "_nea") 1 0)
param (fix (vlax-curve-getParamAtPoint pline pick-pt))
p1 (trans (vlax-curve-getPointAtParam pline param) 0 normal)
p2 (trans (vlax-curve-getPointAtParam pline (1+ param))
0
normal
)
start nil
)
(if (zerop (setq bulge (vla-getBulge pline param)))
(if (clockwise-p p1 p2 side)
(setq start (polar p1 (- (angle p1 p2) (/ pi 2)) ofdist)
end (polar p2 (- (angle p1 p2) (/ pi 2)) ofdist)
)
(setq start (polar p1 (+ (angle p1 p2) (/ pi 2)) ofdist)
end (polar p2 (+ (angle p1 p2) (/ pi 2)) ofdist)
)
)
(progn
(setq b-data (polyarc-data bulge p1 p2))
(if (< (cadr b-data) (distance (car b-data) side))
(setq start (polar p1 (angle (car b-data) p1) ofdist)
end (polar p2 (angle (car b-data) p2) ofdist)
)
(if (< ofdist (cadr b-data))
(setq start (polar p1 (angle p1 (car b-data)) ofdist)
end (polar p2 (angle p2 (car b-data)) ofdist)
)
)
)
)
)
(if start
(progn
(setq new
(vlax-invoke
space
'addLightWeightPolyline
(list (car start) (cadr start) (car end) (cadr end))
)
)
(vla-getWidth pline param 'swid 'ewid)
(vla-setBulge new 0 bulge)
(vla-setWidth new 0 swid ewid)
(foreach prop '(Elevation Layer Linetype
LinetypeGeneration LinetypeScale
Lineweight Normal TrueColor
)
(if (vlax-property-available-p pline prop)
(vlax-put new prop (vlax-get pline prop))
)
)
)
(princ "\nOffset distance is greater than arc radius.")
)
)
(princ)
)