[分享]：批量偏移程序

winsbol

非常感谢楼主，下载用用

wensg

好东西,谢谢斑竹.

lanbosui

感谢楼主的分享！

Archs

确实不错，不用一个一个去选了。谢谢楼主！

twtwvl

试试看一下怎么样效果

staf_raul

刚刚学习

szmaicy

;迷你建筑工具修改版
;批量偏移，可选择双向或单向、到实体层或当前层及是否保留原实体。
;与offset命令用法类似。
; =============================================================================
; Filename    :   MultiOffset.lsp
; Datum       :   21.11.00
; Author      :   jme
; Copyright   :   MENZI ENGINEERING GmbH, Switzerland
; Revision  1 :   19.07.01 jme - Ellipse and Spline added
;                              - Prompt for delete original objects
; Revision  2 :   14.06.02 jme - Bug OFFSETDIST -1 fixed
; Revision  3 :   12.08.04 jme - Layer support added
; Revision  4 :   15.08.04 jme - Modified for ActiveX
; Revision  5 :   11.10.05 jme - Xline support added
; Revision  6 :   __.__.__ ___ -
; -----------------------------------------------------------------------------
; Known bugs:
; - None (exept the original AutoCAD Offset bug)
; -----------------------------------------------------------------------------
; Description:
; Offsets entities to both sides of the original entity.
; -----------------------------------------------------------------------------
; Global variables:
; Me:Del  Me:Dst  Me:Lmd
; -----------------------------------------------------------------------------
; Internal LISP-functions:
; MeAll2String MeGetLockedLayers MeList2String MeOffset
; -----------------------------------------------------------------------------
; External LISP-functions:
;
; -----------------------------------------------------------------------------
; Version notes:
; AutoCAD:    Version:    Language:    AddIns:
; 15+        1.05        English        ...
; -----------------------------------------------------------------------------
;
; == Message on loading =======================================================
;
;(princ "\nMultiOffset v1.05")
;
; == Main =====================================================================
;
(defun C:MultiOffset ( / old_autolay olderr old_cmd AcaDoc old_Layer CurSet CurEnt CurObj FltLst len1 len2
                         FstLst LokLst NxtLst TmpStr Me:Dst Me:Lmd  Me:Del mini_start mini_error1  mini_end
                          MeAll2String  MeGetLockedLayers  MeList2String  MeOffset)
                        
(defun mini_start ()
  (gc)
  (setq old_cmd (list (getvar "cmdecho") (getvar "clayer") (getvar "cecolor") autolay *error*))
  (setvar "cmdecho" 0)
  (setvar "cecolor" "BYLAYER")
  (setvar "blipmode" 0)  ;消除影点变量
  (command "undo" "group")
  (setq *error*  mini_error1)
  (princ)
)
(defun mini_end ()
  (setq *error* (nth 4 old_cmd)
        autolay (nth 3 old_cmd)
  )
  (setvar "clayer" (cadr old_cmd))
  (setvar "cecolor" (caddr old_cmd))
  (command "_.undo" "end")
  (setvar "cmdecho" (car old_cmd))
  (princ)
)
(defun mini_error1 (s)
  (if (not (member s '("console break" "Function cancelled" "quit / exit abort")))
      (princ (strcat "\nError: " s))
  )
  (mini_end)
)
                        
                        
;
; == Subs =====================================================================
;
; -- Function MeAll2String
; Converts all variable types to a string.
; Arguments [Type]:
;   Val = Value to convert [INT/REAL/LIST/STR]
; Return [Type]:
;   > Converted value [STR]
; Notes:
;   None
;
(defun MeAll2String (Val)
(cond
  ((= (type Val) 'INT ) (itoa Val))
  ((= (type Val) 'REAL) (rtos Val))
  ((= (type Val) 'LIST) (MeList2String Val " "))
  ((= (type Val) 'STR ) Val)
  (T "")
)
)
;
; -- Function MeGetLockedLayers
; Returns a list of all locked layers
; Arguments [Typ]:
;   Acd = Acad document object [VLA-OBJECT]
; Return [Typ]:
;   > Layer names [LIST]
;   > nil if none
; Notes:
;   None
;
(defun MeGetLockedLayers (Acd / NmeLst)
(vlax-for Obj (vla-get-Layers Acd)
  (if (= (vla-get-Lock Obj) :vlax-true)
   (setq NmeLst (cons (vla-get-name Obj) NmeLst))
  )
  (vlax-release-object Obj)
)
(reverse NmeLst)
)
;
; -- Function MeList2String
; Converts a list to a string with selectable delimiter.
; Arguments [Typ]:
;   Lst = List [LIST]
;   Del = Delimiter [STR]
; Return [Typ]:
;   > Converted list [STR]
; Notes:
;   None
;
(defun MeList2String (Lst Del)
(apply 'strcat
  (cons
   (MeAll2String (car Lst))
   (mapcar
   '(lambda (l) (strcat Del (MeAll2String l)))
    (cdr Lst)
   )
  )
)
)
;
; -- Function MeOffset
; Error watched Offset methode.
; Arguments [Type]:
;   Obj = Object to offset [VLA-OBJECT]
;   Dst = Offset distance [REAL]
; Return [Type]:
;   > Offset object list [LIST]
;   > False if offset fails
; Notes:
;   None
;
(defun MeOffset (Obj Dst / TmpLst)
(if (not
      (vl-catch-all-error-p
       (setq TmpLst (vl-catch-all-apply 'vlax-invoke (list Obj 'Offset Dst)))
      )
     )
     (car TmpLst)
)
)
                        
                        
                        
                        
   (mini_start)
   (princ "\n 2000-2005 MENZI ENGINEERING GmbH, Switzerland,迷你建筑工具修改版。")
   (vl-load-com)
   (setq AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object))
         LokLst (MeGetLockedLayers AcaDoc)
         Mini_MultiOffset (cond (Mini_MultiOffset) ((list (getvar "OFFSETDIST") "F" "Y")))
         Me:Dst (car Mini_MultiOffset)
         Me:Lmd (cadr Mini_MultiOffset)
         Me:Del (caddr Mini_MultiOffset)
         LokLst (cond (LokLst (MeList2String LokLst ",")) ("~*"))
         FltLst (list
                '(-4 . "<OR")
                 '(0 . "ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE,SPLINE,XLINE")
                 '(-4 . "<AND")
                  '(0 . "POLYLINE")
                  '(-4 . "<NOT")
                   '(-4 . "<OR")
                    '(-4 . "&=") '(70 .  8);3DPoly
                    '(-4 . "&=") '(70 . 16);3DMesh
                    '(-4 . "&=") '(70 . 64);PolyFace
                   '(-4 . "OR>")
                  '(-4 . "NOT>")
                 '(-4 . "AND>")
                '(-4 . "OR>")
                '(-4 . "<NOT") (cons 8 LokLst) '(-4 . "NOT>")
                )
   )
   (if (setq CurSet (cond ((ssget "I" FltLst))
                          ((ssget FltLst))
                    )
       )
    (progn
   ;(initget 6)
     (setq Me:Dst (cond ((getdist (strcat "\n 偏移距离【正数外偏，负数内偏】: <" (rtos Me:Dst) ">"))) (Me:Dst)))
     (initget "F C")
     (setq Me:Lmd (cond ((getkword (strcat "\n 生成实体所在图层【原实体层 F /当前层 C 】: <" Me:Lmd ">"))) (Me:Lmd)))
     (initget "Y N")
     (setq Me:Del (cond ((getkword (strcat "\n 是否删除原实体?[是 Y /否 N ]:<" Me:Del ">"))) (Me:Del)))
     (setq Mini_MultiOffset (list Me:Dst Me:Lmd Me:Del))
     (while (setq CurEnt (ssname CurSet 0))
      (setq CurObj (vlax-ename->vla-object CurEnt)
            FstLst (MeOffset CurObj (abs Me:Dst))
            NxtLst (MeOffset CurObj (- (abs Me:Dst)))
      )
      (if (eq Me:Lmd "C")
          (mapcar '(lambda (l) (vla-put-Layer l old_Layer)) (list FstLst NxtLst))
      )
      (ssdel CurEnt CurSet)
      (if (and FstLst NxtLst)
          (progn (setq len1 (vlax-curve-getDistAtParam CurObj (vlax-curve-getendparam CurObj))
                       len2 (vlax-curve-getDistAtParam FstLst (vlax-curve-getendparam FstLst))
                 )
                 (vla-delete (cond ((and (> Me:Dst 0) (> len2 len1)) NxtLst)
                                   ((and (> Me:Dst 0) (< len2 len1)) FstLst)
                                   ((and (< Me:Dst 0) (> len2 len1)) FstLst)
                                   ((and (< Me:Dst 0) (< len2 len1)) NxtLst)
                                   ((and (> Me:Dst 0) (mai_equal len2 len1)) NxtLst)
                                   ((and (< Me:Dst 0) (mai_equal len2 len1)) FstLst)
                             )
                 )
                 (if (= Me:Del "Y") (vla-delete CurObj))
          )
      )
     )
    )
   )
   (mini_end)
)

jadekylin

以前用的都是其中一个功能，现在集成在一起，很实用！

fangzheng158

本人初学vlisp, 多谢楼主给我参考

daidong013

东西真的不错，程序非常好用

jize1980

可以参考啊，不知道哪个好

zhaozwf

狂刀的不错啊

longer1000

非常感谢啊，我找了好久了。多谢高手们

yinjake007

都不知怎么用啊，建议大家以后最好说明一下打什么命令

biaoge1981

请问分不分图层的