[code="lisp]
(defun c:test1 (/ ent bul dt p
pt pt0 laste th-pl-getsegat
txt-mkline th2o txt-3rd txt-4th
txt-5th
)
(defun thado ()
(cond
(%$*thado*$%)
(setq %$*thado*$% (vlax-get-acad-object))
)
)
(defun thactdoc ()
(cond
(%$*thactdoc*$%)
(setq %$*thactdoc*$% (vla-get-activedocument (thado)))
)
)
(defun th-pl-getsegat (obj p / blg p1 p2 pa pcen pn v)
(setq pn (vlax-curve-getclosestpointto obj (trans p 1 0))
pa (fix (vlax-curve-getparamatpoint obj pn))
p1 (vlax-curve-getpointatparam obj pa)
p2 (vlax-curve-getpointatparam obj (1+ pa))
)
(setq obj (th2o obj))
(setq blg (vla-getbulge obj pa))
(if (zerop blg)
(list "kLine" (list pa (1+ pa)) p1 p2)
(progn
(setq v (vlax-curve-getsecondderiv obj pa)
pcen (mapcar
'+
p1
v
)
)
(if (> blg 0)
(list "kArc" (list pa (1+ pa)) pcen p1 p2)
(list "kArc"
(list pa (1+ pa))
(mapcar
'-
p1
v
)
p2
p1
)
)
)
)
)
(defun txt-mkline (p1 p2 / ent)
(if (setq ent (entmakex (list '(0 . "LINE")
'(100 . "AcDbEntity")
'
(100 . "AcDbLine")
(cons 10 p1)
(cons 11 p2)
'(210 0. 0. 1.)
)
)
)
ent
)
)
(defun th2o (object)
(cond
((is-ename object)
(vlax-ename->vla-object object)
)
((is-vla-object object)
object
)
((is-string object)
(vl-catch-all-apply
'(lambda ()
(vla-handletoobject (thactdoc) object)
)
)
)
(t
nil
)
)
)
(defun txt-3rd (lst)
(caddr lst)
)
(defun txt-4th (lst)
(cadddr lst)
)
(defun txt-5th (lst)
(car (cddddr lst))
)
(if (and
(setq p (entsel "\n点取多义线:"))
(setq pt0 (getpoint "\n偏移方向:"))
(setq dt (getdist "\n偏移距离:"))
)
(progn
(setq ent (car p)
pt (cadr p)
)
(setq bul (th-pl-getsegat (th2o ent) (osnap pt "_nea")))
(cond
((= (car bul) "kLine")
(setq laste (txt-mkline (txt-3rd bul) (txt-4th bul)))
(vl-cmdf "_.OFFSET" dt laste "_non" pt0 "")
(entdel laste)
)
((= (car bul) "kArc")
(vl-cmdf "_.ARC"
"C"
(txt-3rd bul)
(txt-4th bul)
(txt-5th bul)
)
(setq laste (entlast))
(vl-cmdf "_.OFFSET" dt laste "_non" pt0 "")
(entdel laste)
)
)
)
)
(princ)
)
[/code]