我还有一个问题。
我必须将除原始多边形之外的层更改为我创建的特定层。
如何更改除原始多边形外的层生成实体？
谢谢你的帮助。 您是指新创建的直线和圆弧（在当前活动层中创建），并将原始多段线保留在其当前指定的层中，该多段线已放置在其中？ Marko_ribar，
那么默认值对lisp有什么作用呢？我将其添加到代码中，以使新行更改到不同的层。
(entmake (vl-list* '(0 . "LINE") (cons 10 (trans a e 0)) (cons 11 (trans b e 0)) p))
(vl-catch-all-apply 'vlax-put (list (vlax-ename->vla-object (entlast)) 'Layer "Router - Blue - Cuts")) 创建新图层并使其成为当前图层，同时根据需要更改当前颜色，最后应用此版本：
请注意，现在您不需要（LM:defaultprops）。。。
HTH。，M、 R。
感谢mods，如果内部偏移距离大于弧半径，您的评论将指导我们修复错误
更新v1.1-检查较大半径
感谢李的子功能
;; arc offset is always in direction so that new arc is larger than its reference arced segment of lwpolyline - M.R
(defun c:offs ( / LM:listclockwise-p LM:defaultprops xy ob l i s p e d )
(vl-load-com)
;; List Clockwise-p - Lee Mac
;; Returns T if the point list is clockwise oriented
(defun LM:listclockwise-p ( lst )
(minusp
(apply '+
(mapcar
'(lambda( a b ) (- (* (car b) (cadr a)) (* (car a) (cadr b)))
)
lst (cons (last lst) lst)
)
)
)
)
;; Default Properties-Lee Mac
;; Returns a list of DXF properties for the supplied DXF data,
;; substituting default values for absent DXF groups
(defun LM:defaultprops ( enx )
(mapcar '(lambda ( x ) (cond ((assoc (car x) enx)) ( x )))
'(
(006 . "BYLAYER")
(008 . "0")
(039 . 0.0)
(048 . 1.0)
(062 . 256)
(370 . -1)
)
)
)
(prompt "\nSelect closed lwpolylines...")
(and (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
(progn (initget 7)
(setq xy '(( l )(if l (cons (list (car l)(cadr l)) (xy (cddr l)))))
d (getdist "\nPick or specify offset : ")
)
)
(repeat (setq i (sslength s))
(setq e(ssname s (setq i (1- i)))
ob (vlax-ename->vla-object e)
p(LM:defaultprops (entget e))
l(xy (vlax-get ob 'coordinates))
)
(mapcar
'(lambda ( x )
(vl-catch-all-apply 'mapcar
(cons
'(lambda ( f / o b r) (setq f (eval (read (strcat "vlax-curve-get" f)))
r ( (if (LM:listclockwise-p l)
+
-
)
d
)
o (vl-catch-all-apply 'vlax-invoke (list x 'offset r ) )
o (if (listp o)(car o) o )
)
(if (and (= (vla-get-ObjectName x) "AcDbArc")
(setq b (vl-catch-all-apply 'vlax-invoke (list x 'offset (- r)))
b (if (listp b) (car b) b))
)
(if
(apply
'>
(mapcar
'(lambda (a / ) (atof (vl-princ-to-string (vl-catch-all-apply 'vlax-get (list a 'Radius)))))
(list x b )
)
)
(vla-erase b)
(progn (vla-erase o)(setq o b))
)
)
(entmakex (vl-list* '(0 . "LINE") (cons 10 (f x)) (cons 11 (f o)) p))
)
'(("startpoint" "endpoint"))
)
); catch
(vla-erase x)
)
(vlax-invoke ob 'explode)
) ;mapcar
) ;repeat
) ;and
(princ)
)
我修改了版本，加入了Truecolors。。。
谢谢你的帮助~
谢谢你的帮助~ 马尔科·里巴
我知道这本书最初是李写的，我并不是想从他那里拿走它，我只是为了我需要的东西而修改，但我需要一些帮助。如果有人能帮我，我将不胜感激。请看红色的评论。
(defun c:segoff ( / a b d e i l n p s v x y z )
(initget 6)
(if (and (setq d (getdist "\nSpecify offset: "))
(setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1) (-4 . "<NOT") (-4 . "<>") (42 . 0.0) (-4 . "NOT>"))))
(setq num -1)
)
(repeat (setq i (sslength s))
(setq VlaObj (vlax-ename->vla-object (ssname s (setq num (1+ num)))))
(vl-catch-all-apply 'vlax-put (list VlaObj 'Layer "LAYER NAME"))
(setq i (1- i)
e (ssname s i)
x (entget e)
p (LM:defaultprops x)
z (list (cdr (assoc 38 x)))
l nil
)
(while (setq v (assoc 10 x))
(setq l (cons (append (cdr v) z) l)
x (cdr (member v x))
)
)
(setq n (/ pi (if (LM:listclockwise-p l) 2 -2)))
(mapcar
'(lambda ( x y / a b )
(setq a (+ (angle x y) n)
b (list x (polar x a d) (polar y a d) y)
)
(mapcar
'(lambda ( a b )
(entmake (vl-list* '(0 . "LINE") (cons 10 (trans a e 0)) (cons 11 (trans b e 0)) p))
(vl-catch-all-apply 'vlax-put (list (vlax-ename->vla-object (entlast)) 'Layer "LAYER NAME"))
)
b (cdr b)
)
)
(cons (last l) l) l
)
)
)
(setq obj (vl-catch-all-apply 'vlax-invoke (list VlaObj 'explode))) ;;; I'm trying to figure out how to collect the lines this creates to use on the next step
(setq objLst(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr(ssnamex obj)))))
(vla-StartUndoMark (setq actDoc (vla-get-ActiveDocument (vlax-get-acad-object))))
(foreach ln objLst (vlax-put ln 'startpoint (polar (vlax-get ln 'startpoint)(vlax-get ln 'angle)(- d))))
(foreach ln objLst (vlax-put ln 'endpoint (polar (vlax-get ln 'endpoint)(vlax-get ln 'angle)d)))
(vla-EndUndoMark actDoc)
(vl-catch-all-apply 'vla-delete (list VlaObj))
(princ)
)
;; List Clockwise-p - Lee Mac
;; Returns T if the point list is clockwise oriented
(defun LM:listclockwise-p ( lst )
(minusp
(apply '+
(mapcar
(function
(lambda ( a b )
(- (* (car b) (cadr a)) (* (car a) (cadr b)))
)
)
lst (cons (last lst) lst)
)
)
)
)
;; Default Properties-Lee Mac
;; Returns a list of DXF properties for the supplied DXF data,
;; substituting default values for absent DXF groups
(defun LM:defaultprops ( enx )
(mapcar '(lambda ( x ) (cond ((assoc (car x) enx)) ( x )))
'(
(006 . "BYLAYER")
(008 . "TOP")
(039 . 0.0)
(048 . 1.0)
(062 . 256)
(370 . -1)
)
)
)
(princ)
谢谢
布瑞恩 @布莱恩，
要在vla爆炸后收集实体，我建议您使用类似的技术：
6
页:
1
[2]