不支持自交的多段线,自交的样条曲线,以及无法偏移的各类线。
图层、线型必须加载好了的。
 - (defun c:o1()
- ;;(sk_offset 图层 颜色 线型 线宽)
- ;(sk_offset nil nil nil nil)
- (sk_offset "Text" 8 "ACAD_ISO03W100" 211)
- (princ)
- )
- ;;;;简单版偏移后改属性函数2014-4-24
- ;;;;(sk_offset 图层 颜色 线型 线宽)
- ;;;;;(sk_offset nil nil nil nil)
- (defun sk_offset(sk_lay sk_color sk_lt sk_lw / sk_dist1 ss p0 p1 p2 obj obj-offset obj-offset1 obj-offset2)
- (vl-load-com)
- (if sk_dist
- (and(setq sk_dist1(getdist (strcat "\n请输入偏移距离["(rtos sk_dist) "]:")))(setq sk_dist sk_dist1))
- (setq sk_dist(getdist "\n请输入偏移距离:"))
- )
- (if sk_dist
- (while (and (setq ss(ssget ":E:S" '((0 . "*LINE,ELLIPSE,CIRCLE,ARC"))))
- )
- (setq obj (vlax-ename->vla-object (ssname ss 0)))
- (vla-Highlight obj :vlax-true)
- (if (setq p0(getpoint "\n请指定偏移方向:"))
- (progn
- (setq obj-offset1(vlax-invoke-method obj 'offset sk_dist))
- (setq obj-offset2(vlax-invoke-method obj 'offset (* sk_dist -1)))
- (setq obj-offset1(vlax-safearray-get-element(vlax-variant-value obj-offset1) 0))
- (setq obj-offset2(vlax-safearray-get-element(vlax-variant-value obj-offset2) 0))
- (setq p1(vlax-curve-getClosestPointTo obj-offset1 p0)
- p2(vlax-curve-getClosestPointTo obj-offset2 p0))
- (if (> (distance p0 p1) (distance p0 p2))
- (progn(setq obj-offset obj-offset2)(vla-delete obj-offset1))
- (progn(setq obj-offset obj-offset1)(vla-delete obj-offset2))
- )
- ;(and sk_lay (vlax-put-property 'layer obj-offset sk_lay))
- (and sk_lay (vla-put-layer obj-offset sk_lay))
- (and sk_color (vla-put-color obj-offset sk_color))
- (and sk_lt (vla-put-linetype obj-offset sk_lt))
- (and sk_lw (vla-put-lineweight obj-offset sk_lw))
- )
- )
- (vla-Highlight obj :vlax-false)
- )
- )
- (princ)
- )
- (princ)
|