批量偏移并置为当前图层

潇湘飞雨 · 发表于 2019-7-5 12:24

;;;批量偏移
;;;ago9999,梨胡鸟编写(QQ17137646)
(defun c:py (/ en offd pt py_fs offd dx_ss dx_ss dx_n pt pt0 n)
  (command "undo" "be")                      ; 定义返回点
  (setvar "cmdecho" 0)                      ; 关闭命令提示

  (if (or (= py_fs0 nil) (eq py_fs0 ""))
(setq py_fs0 "Z")
  )
  (princ "\n请输入偏移方式[正向(Z)/反向(F)/双向(S)/通过(T)]<")
  (princ py_fs0)                      ;输入偏移方式
  (princ ">:")
  (setq py_fs (getstring))
  (if (or (= py_fs nil) (eq py_fs ""))
(setq py_fs py_fs0)
(setq py_fs0 py_fs)
  )

  (if (or (eq py_fs "t") (eq py_fs "T"))
(princ "\n采用通过点偏移方式")
(progn
   (if (= offd0 nil)
      (setq offd0 "0")
   )
   (princ "\n请输入偏移距离(")
   (princ offd0)
   (princ ")")                      ;输入偏移距离
   (setq offd (getdist))
   (if (= offd nil)
      (setq offd offd0)
      (setq offd0 offd)
   )
)
  )

  (princ "\n请选择线段,弧,圆,多段线:")
  (setq dx_ss (ssget))
  (if (or (eq py_fs "s") (eq py_fs "S"))
(setq pt (list 0 0))
(setq pt (getpoint "\n请选择基点"))
  )                                     ;输入偏移基点

  (setq n 0)
  (while (< n (sslength dx_ss))
(setq dx_n (ssname dx_ss n))
(if
   (or (eq py_fs "t") (eq py_fs "T"))
   (command "OFFSET" "t" dx_n pt "")
   (progn
      (cond
         ((or       (eq "LINE" (cdr (assoc '0 (entget dx_n))))
            (eq "LWPOLYLINE" (cdr (assoc '0 (entget dx_n))))
         )
         (command "OFFSET" offd dx_n pt "") ;正向偏移
         (setq ptst (cdr (assoc '10 (entget dx_n))))
         (setq pten (cdr (assoc '10 (entget (entlast)))))

         (if       (or (eq py_fs "f") (eq py_fs "F")) ;正向偏移删除
            (command "ERASE" "l" "")
         )
         (if       (or (eq py_fs "f")
                  (eq py_fs "F")
                  (eq py_fs "s")
                  (eq py_fs "S")
            )                      ;反向偏移
            (progn
            (setq pt0 (list       (- (* 2 (nth 0 ptst)) (nth 0 pten))
                              (- (* 2 (nth 1 ptst)) (nth 1 pten))
                        )
            )
            (command "OFFSET" offd dx_n pt0 "")
            )
         )
         )
         ((or       (eq "ARC" (cdr (assoc '0 (entget dx_n))))
            (eq "CIRCLE" (cdr (assoc '0 (entget dx_n))))
         )
         (command "OFFSET" offd dx_n pt "") ;正向偏移
         (setq rst (cdr (assoc '40 (entget dx_n))))
         (setq ren (cdr (assoc '40 (entget (entlast)))))

         (if       (or (eq py_fs "s") (eq py_fs "S")) ;正向偏移复制
            (command "copy" "l" "" "0,0,0" "0,0,0")
         )
         (if       (or (eq py_fs "f")
                  (eq py_fs "F")
                  (eq py_fs "s")
                  (eq py_fs "S")
            )                      ;反向偏移
            (progn
            (setq r0 (- (* 2 rst) ren))
            (if (<= r0 0)
               (command "ERASE" "l" "") ;正向偏移删除
               (progn
                  (setq dx_n0 (entget (entlast)))
                  (setq dx_n0
                        (subst (cons '40 r0) (assoc '40 dx_n0) dx_n0)
                  )
                  (entmod dx_n0)
               )                      ;正向偏移更改
            )
            )
         )
         )
      )

   )
)
(setq n (1+ n))
  )
(command "Chprop" (entlast) "" "La" (Getvar 'Clayer) "") ；偏移的对象只有1根置为当前，求指正！！
  (command "undo" "e")                      ; 定义返点
  (setvar "cmdecho" 1)                      ; 打开命令提示
  (princ)
)

Andyhon · 发表于 2019-7-6 12:50

Returns the name of the last nondeleted main object (entity) in the drawing

(entlast)
The entlast function is frequently used to obtain the name of a new entity that has just been added with the command function. To be selected, the entity need not be on the screen or on a thawed layer.

============

您的情况应先建立空的选集 (setq Ofst_ss (ssadd))
在回圈内加入 (entlast)

==>
(command "Chprop" Ofst_ss "" "La" (Getvar 'Clayer) "")

潇湘飞雨 · 发表于 2019-7-5 12:25

(command "Chprop" (entlast) "" "La" (Getvar 'Clayer) "") ；偏移的对象只有1根置为当前，求指正！！

paulpipi · 发表于 2019-7-6 23:04

学习一下，谢谢

潇湘飞雨 · 发表于 2019-7-8 16:06

Andyhon 发表于 2019-7-6 12:50
Returns the name of the last nondeleted main object (entity) in the drawing

(entlast)

感谢大师指点~！

403181713 · 发表于 2019-8-19 11:23

感谢分享辛苦了

bai2000 · 发表于 2019-8-22 15:20

664571221 · 发表于 2019-10-21 10:24

你好能否改一个完整的版本

账号		自动登录	找回密码
密码			注册