求高手帮改改，偏移为当前图层

新不由己

(defun c:11 (/ getds obj)
  (vl-load-com)
  (setvar 'cmdecho 0)
  (initget 2)
  (setq getds (getdist "\n输入偏移距离<可直接量取>:"))
  (if (ssget ":s" '((0 . "Arc,Circle,Ellipse,*Line")))
    (vlax-for obj (vla-get-activeselectionset
        (vla-get-activedocument (vlax-get-acad-object))
      )
      (vla-offset obj getds)
      (vla-offset obj (* getds -1))
    )
    (vlax-release-object obj)
  )
  (if (not (getpoint "\n按鼠标左键不删除源对象 <空格删除>"))
    (command "_.ERASE" (ssget "p") "")
    )
  (princ)
)

Linhay

(command "offset" "l" "c")

434939575

2. (defun c:11 (/ getds obj)
   
3.   (vl-load-com)
   
4.   (setq lay (getvar "CLAYER"))
   
5.   (setvar 'cmdecho 0)
   
6.   (initget 2)
   
7.   (setq getds (getdist "\n输入偏移距离<可直接量取>:"))
   
8.   (if (ssget ":s" '((0 . "Arc,Circle,Ellipse,*Line")))
   
9.    (progn
   
10.      (vlax-for obj (vla-get-activeselectionset
    
11.         (vla-get-activedocument (vlax-get-acad-object))
    
12.       )
    
13.      (foreach x (list getds  (* getds -1))
    
14.        (vla-offset obj x )
    
15.        (vla-put-layer (vlax-ename->vla-object (entlast)) lay)
    
16.        )
    
17.       
    
18.     )
    
19. 
    
20. 
    
21.      )
    
22.     (vlax-release-object obj)
    
23.   )
    
24.   (if (not (getpoint "\n按鼠标左键不删除源对象 <空格删除>"))
    
25.     (command "_.ERASE" (ssget "p") "")
    
26.     )
    
27.   (princ)
    
28. )

(defun c:11 (/ getds obj)<br />   (vl-load-com)<br />   (setq lay (getvar "CLAYER"))<br />   (setvar 'cmdecho 0)<br />   (initget 2)<br />   (setq getds (getdist "\n输入偏移距离<可直接量取>:"))<br />   (if (ssget ":s" '((0 . "Arc,Circle,Ellipse,*Line")))<br />    (progn<br />      (vlax-for obj (vla-get-activeselectionset<br />         (vla-get-activedocument (vlax-get-acad-object))<br />       )<br />      (foreach x (list getds  (* getds -1))<br />        (vla-offset obj x )<br />        (vla-put-layer (vlax-ename->vla-object (entlast)) lay)<br />        )<br />       <br />     )<br /> <br /> <br />      )<br />     (vlax-release-object obj)<br />   )<br />   (if (not (getpoint "\n按鼠标左键不删除源对象 <空格删除>"))<br />     (command "_.ERASE" (ssget "p") "")<br />     )<br />   (princ)<br /> )

edata

借用二楼代码简单修改。

1. (defun c:11 (/ getds obj RetVal objarray x k)
   
2.   (vl-load-com)
   
3.   (setq lay (getvar "CLAYER"))
   
4.   (setvar 'cmdecho 0)
   
5.   (initget 2)
   
6.   (setq getds (getdist "\n输入偏移距离<可直接量取>:"))
   
7.   (if (ssget ":s" '((0 . "Arc,Circle,Ellipse,*Line")))
   
8.     (progn
   
9.       (vlax-for        obj (vla-get-activeselectionset(vla-get-activedocument(vlax-get-acad-object)))
   
10.         (foreach x (list getds (* getds -1))          
    
11.           (setq RetVal(vl-catch-all-apply 'vla-offset (list obj x )))
    
12.           (if (vl-catch-all-error-p RetVal)
    
13.             (princ (vl-catch-all-error-message RetVal))
    
14.             (progn
    
15.               (setq objarray (vlax-variant-value RetVal))
    
16.               (foreach k (vlax-safearray->list objarray)
    
17.                 (vla-put-layer k lay)
    
18.                 )
    
19.               )
    
20.             )          
    
21.           )
    
22.         )
    
23.       )
    
24.     (vlax-release-object obj)
    
25.   )
    
26.   (if (not (getpoint "\n按鼠标左键不删除源对象 <空格删除>"))
    
27.     (command "_.ERASE" (ssget "p") "")
    
28.   )
    
29.   (princ)
    
30. )

(defun c:11 (/ getds obj RetVal objarray x k)<br />   (vl-load-com)<br />   (setq lay (getvar "CLAYER"))<br />   (setvar 'cmdecho 0)<br />   (initget 2)<br />   (setq getds (getdist "\n输入偏移距离<可直接量取>:"))<br />   (if (ssget ":s" '((0 . "Arc,Circle,Ellipse,*Line")))<br />     (progn<br />       (vlax-for        obj (vla-get-activeselectionset(vla-get-activedocument(vlax-get-acad-object)))<br />         (foreach x (list getds (* getds -1))          <br />           (setq RetVal(vl-catch-all-apply 'vla-offset (list obj x )))<br />           (if (vl-catch-all-error-p RetVal)<br />             (princ (vl-catch-all-error-message RetVal))<br />             (progn<br />               (setq objarray (vlax-variant-value RetVal))<br />               (foreach k (vlax-safearray->list objarray)<br />                 (vla-put-layer k lay)<br />                 )<br />               )<br />             )          <br />           )<br />         )<br />       )<br />     (vlax-release-object obj)<br />   )<br />   (if (not (getpoint "\n按鼠标左键不删除源对象 <空格删除>"))<br />     (command "_.ERASE" (ssget "p") "")<br />   )<br />   (princ)<br /> )

新不由己

edata 发表于 2018-5-13 17:48
借用二楼代码简单修改。

新不由己

434939575 发表于 2018-5-13 09:22

大尾巴狼

Linhay 发表于 2018-5-15 18:56
(command "offset" "l" "c")

就这么简单