没有offsetgaptype的偏移，
大家好，我正在寻找一种在不改变线段长度的情况下偏移多段线的方法。
我研究了offsetgaptype，但不缩小差距的选项不在其中。
下面是我想要的示例，应该删除粉红色部分：
https://www.cadtutor.net/forum/attachment.php?attachmentid=59394&cid=1&stc=1
我不介意自己编写一些代码，但我不知道如何分别偏移这些段，也不知道如何确定选择了哪一侧。
非常感谢您的帮助。
快速而肮脏的示例。。。
(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)
(setq clayer (getvar "clayer"))
(if (and
(if (setq dst (getdist (strcat "\nSpecify Offset Distance or <" (rtos (abs (getvar 'Offsetdist)) 2 4) ">: ")))
(setvar 'Offsetdist dst)
(setq dst (abs (getvar 'Offsetdist)))
)
(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-put-layer (vlax-EName->vla-Object (entlast)) clayer)
(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
)
) 你的Mod上的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 <"
(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
)
页:
[1]