请帮忙改一下这个程序

dhy

这个程序是以前在论坛里面下载的，忘记是哪位大虾写的了，这段时间经常用到，可是发现有个不是很方便的地方，所以请高手帮忙改一下，把偏移后的线段变成目前层。比如原封闭线图层是PH层，当前层是D层，偏移出来的线段就是D层，原来的的封闭线不变；如果当前层是1层，偏移出来的线段就是1层，原来的的封闭线不变；就这样。
源码如下
;;;;封闭线单段偏移
(defun c:oo (/ od ss_1 s1 s3 s2 sa sa1 ssK3 e)
  (Setvar "cmdecho" 0)
  (command "_undo" "g")
  (setq od (getvar 'offsetdist))
  (princ "\n 请输入偏移复制距离<")
  (princ od)
  (princ ">")
  (setq od (getreal))
  (if od
    (setvar 'offsetdist od)
  )
  (prompt "\n 请选择要偏移复制的图元")
  (SETQ ss_1 NIL)
  (WHILE (null ss_1)
    (setq ss_1 (entsel))
  )
  (SETQ S1 (CaR SS_1))
  (redraw s1 3)
  (prompt "\n 请选择偏移复制方向")
  (setq s3 (getpoint))
  (IF (= (cdr (assoc 0 (entget s1))) "LWPOLYLINE")
    (PROGN
      (setq s2 (CAR (cdr ss_1)))
      (setq sa (entlast))
      (command "_explode" s1)
      (setq sa1 (ssnamex (ssget s2)))
      (setq ssk3 (ssadd))
      (setq e (entnext sa))
      (ssadd e ssk3)
      (while e
        (setq e (entnext e))
        (if e
          (ssadd e ssk3)
        )
      )
      (SETQ s1 (nth 1 (car sa1)))
      (command "_offset" "" s1 s3 "")
      (command "_pedit" s1 "" "j" ssk3 "")
    )
    (command "_offset" "" s1 s3 "")
  )
  (command)
  (command "_undo" "e")
  (princ)
)

lenlenq

在 (command "_offset" "" s1 s3 "")
之后加
(setq en (entlast))
  (command"change" en "" "p" "la" (getvar"clayer") "" )
即可

yjr111

也可以这样

2. ;;;;封闭线单段偏移
   
3. (defun c:oo (/ od ss_1 s1 s3 s2 sa sa1 ssK3 e)
   
4.   (vl-load-com)
   
5.   (setq mycad(vlax-get-acad-object)
   
6.         mydoc(vla-get-ActiveDocument mycad)
   
7.         myms(vla-get-ModelSpace mydoc)
   
8.         )
   
9. (setq nowLayer(vla-get-name (vla-get-ActiveLayer mydoc)))
   
10. (setvar "clayer" nowLayer)
    
11.   (Setvar "cmdecho" 0)
    
12.   (command "_undo" "g")
    
13.   (setq od (getvar 'offsetdist))
    
14.   (princ "\n 请输入偏移复制距离<")
    
15.   (princ od)
    
16.   (princ ">")
    
17.   (setq od (getreal))
    
18.   (if od
    
19.     (setvar 'offsetdist od)
    
20.   )
    
21.   (prompt "\n 请选择要偏移复制的图元")
    
22.   (SETQ ss_1 NIL)
    
23.   (WHILE (null ss_1)
    
24.     (setq ss_1 (entsel))
    
25.   )
    
26.   (SETQ S1 (CaR SS_1))
    
27.   (redraw s1 3)
    
28.   (prompt "\n 请选择偏移复制方向")
    
29.   (setq s3 (getpoint))
    
30.   (IF (= (cdr (assoc 0 (entget s1))) "LWPOLYLINE")
    
31.     (PROGN
    
32.       (setq s2 (CAR (cdr ss_1)))
    
33.       (setq sa (entlast))
    
34.       (command "_explode" s1)
    
35.       (setq sa1 (ssnamex (ssget s2)))
    
36.       (setq ssk3 (ssadd))
    
37.       (setq e (entnext sa))
    
38.       (ssadd e ssk3)
    
39.       (while e
    
40.         (setq e (entnext e))
    
41.         (if e
    
42.           (ssadd e ssk3)
    
43.         )
    
44.       )
    
45.       (SETQ s1 (nth 1 (car sa1)))
    
46.       (command "_offset" "" s1 s3 "")
    
47.       (vla-put-Layer (setq vla_e1(vlax-ename->vla-object (entlast))) nowlayer)
    
48.       (vla-put-Color vla_e1 acbylayer)
    
49.       (command "_pedit" s1 "" "j" ssk3 "")
    
50.     )
    
51.     (progn
    
52.     (command "_offset" "" s1 s3 "")
    
53.     (vla-put-Layer (setq vla_e1(vlax-ename->vla-object (entlast))) nowlayer)
    
54.     (vla-put-Color vla_e1 acbylayer)
    
55.     )
    
56.     )
    
57.   (command)
    
58.   (command "_undo" "e")
    
59.   (princ)
    
60. )
    

;;;;封闭线单段偏移<br /> (defun c:oo (/ od ss_1 s1 s3 s2 sa sa1 ssK3 e)<br />   (vl-load-com)<br />   (setq mycad(vlax-get-acad-object)<br />         mydoc(vla-get-ActiveDocument mycad)<br />         myms(vla-get-ModelSpace mydoc)<br />         )<br /> (setq nowLayer(vla-get-name (vla-get-ActiveLayer mydoc)))<br /> (setvar "clayer" nowLayer)<br />   (Setvar "cmdecho" 0)<br />   (command "_undo" "g")<br />   (setq od (getvar 'offsetdist))<br />   (princ "\n 请输入偏移复制距离<")<br />   (princ od)<br />   (princ ">")<br />   (setq od (getreal))<br />   (if od<br />     (setvar 'offsetdist od)<br />   )<br />   (prompt "\n 请选择要偏移复制的图元")<br />   (SETQ ss_1 NIL)<br />   (WHILE (null ss_1)<br />     (setq ss_1 (entsel))<br />   )<br />   (SETQ S1 (CaR SS_1))<br />   (redraw s1 3)<br />   (prompt "\n 请选择偏移复制方向")<br />   (setq s3 (getpoint))<br />   (IF (= (cdr (assoc 0 (entget s1))) "LWPOLYLINE")<br />     (PROGN<br />       (setq s2 (CAR (cdr ss_1)))<br />       (setq sa (entlast))<br />       (command "_explode" s1)<br />       (setq sa1 (ssnamex (ssget s2)))<br />       (setq ssk3 (ssadd))<br />       (setq e (entnext sa))<br />       (ssadd e ssk3)<br />       (while e<br />         (setq e (entnext e))<br />         (if e<br />           (ssadd e ssk3)<br />         )<br />       )<br />       (SETQ s1 (nth 1 (car sa1)))<br />       (command "_offset" "" s1 s3 "")<br />       (vla-put-Layer (setq vla_e1(vlax-ename->vla-object (entlast))) nowlayer)<br />       (vla-put-Color vla_e1 acbylayer)<br />       (command "_pedit" s1 "" "j" ssk3 "")<br />     )<br />     (progn<br />     (command "_offset" "" s1 s3 "")<br />     (vla-put-Layer (setq vla_e1(vlax-ename->vla-object (entlast))) nowlayer)<br />     (vla-put-Color vla_e1 acbylayer)<br />     )<br />     )<br />   (command)<br />   (command "_undo" "e")<br />   (princ)<br /> )<br />

tjuzkj

AUTOCAD自带的偏移命令就有更改到当前层的选项

dhy

谢谢两位大虾了。如果要连续操作偏移的动作呢？有应该在哪里改呢？