自己常用的几个AutoCAD改进命令

smartstar

这个个程序也是借鉴修改的

第一个：两点中点的垂线镜像图元（镜像后的图元设定为“上一个选集”）
(defun c:WWE (/ ennn juli p0 p1 ss ssbak)
  (setvar "cmdecho" 0)
  (vl-load-com)
  (defun #err4 (s)
    (command ".UNDO" "E")
    (setq *error* $orr)
  )
  (setq $orr *error*)
  (setq *error* #err4)
  (setq ss (ssget))
  (if (null ss)
    (vl-exit-with-error "")
  )
  (setq p0 (getpoint "\n指定镜像线的第一点:"))
  (if (null p0)
    (vl-exit-with-error "")
  )

  (setq pt2 (getpoint p0 "\n指定镜像线的第二点:"))
  (setq ang (angle p0 pt2))
  (setq dis (distance p0 pt2))
  (setq x1 (- dis (/ dis 2)))
  (setq pt3 (polar p0 ang x1))
  (setq pt4 (polar pt3 (- ang 1.5707963) x1))
  (setq ennn (entlast))
  (command ".MIRROR" ss "" pt3 pt4 pause)
  (setq ssbak (lt:ss-entnext ennn))
    (command "select" ssbak "")    (vl-exit-with-error "")
  (command ".UNDO" "E")
  (setq *error* $orr)
  (princ)
)
第二个：镜像不输“y”（镜像后的图元设定为“上一个选集”）
(defun c:WWW (/ ennn juli p0 p1 ss ssbak)
  (setvar "cmdecho" 0)
  (vl-load-com)
  (defun #err4 (s)
    (command ".UNDO" "E")
    (setq *error* $orr)
  )
  (setq $orr *error*)
  (setq *error* #err4)
  (setq ss (ssget))
  (if (null ss)
    (vl-exit-with-error "")
  )
  (setq p0 (getpoint "\n指定镜像线的第一点:"))
  (if (null p0)
    (vl-exit-with-error "")
    (princ "\n指定镜像线的第二点:")
  )
  (setq ennn (entlast))

  (command ".MIRROR" ss "" p0 pause "y")
  (setq ssbak (lt:ss-entnext ennn))
    (command "select" ssbak "")    (vl-exit-with-error "")
  (command ".UNDO" "E")
  (setq *error* $orr)
  (princ)
)
第三个：和原cad镜像命令相同（镜像后的图元设定为“上一个选集”）
(defun c:WW        (/ ennn juli p0 p1 ss ssbak)
  (setvar "cmdecho" 0)
  (vl-load-com)
  (defun #err4 (s)
    (command ".UNDO" "E")
    (setq *error* $orr)
  )
  (setq $orr *error*)
  (setq *error* #err4)
  (setq ss (ssget))
  (if (null ss)
    (vl-exit-with-error "")
  )
  (setq p0 (getpoint "\n指定镜像线的第一点:"))
  (if (null p0)
    (vl-exit-with-error "")
    (princ "\n指定镜像线的第二点:")
  )
  (setq ennn (entlast))

  (command ".MIRROR" ss "" p0 pause "n")
  (setq ssbak (lt:ss-entnext ennn))
    (command "select" ssbak "")
  (vl-exit-with-error "")
  (command ".UNDO" "E")
  (setq *error* $orr)
  (princ)
)
第四个：和原cad复制命令相同，但将复制的最后一组图元设定为“上一个选集”
(defun c:CC        (/ ennn juli p0 p1 ss ssbak)
  (setvar "cmdecho" 0)
  (vl-load-com)
  (defun #err4 (s)
    (command ".UNDO" "E")
    (command "select" ssbak "")
    (vl-exit-with-error "")
    (setq *error* $orr)
  )
  (setq $orr *error*)
  (setq *error* #err4)
  (setq ss (ssget))
  (if (null ss)
    (vl-exit-with-error "")
  )
  (setq p0 (getpoint "\n指定复制基点:"))
  (if (null p0)
    (vl-exit-with-error "")
  )
  (princ "\n指定第二点, 或输入位移距离:")
  (while t
    (command ".UNDO" "BE")
    (setq ennn (entlast))
    (command ".copy" ss "" p0 pause)
    (setq p1 (getvar "lastpoint"))
    (setq juli (distance p0 p1))
    (if        (= 0 juli)
      ;;-----------------------------------------------
      (progn
        (command ".UNDO" "1")
        (command "select" ssbak "")
        (vl-exit-with-error "")
        (princ)
      )
      ;;-----------------------------------------------
      (progn
        (setq ssbak (lt:ss-entnext ennn))
        (princ "\n指定下一点, 或输入位移距离:"
        )
      )
      ;;-----------------------------------------------
    )
    (command ".UNDO" "E")
  )
  (setq *error* $orr)
  (princ)
)
第五个：复制功能，将“下一点”作为连续复制的“复制基点”，且将复制的最后一组图元设定为“上一个选集”
(defun c:CB        (/ ennn juli p0 p1 ss ssbak)
  (setvar "cmdecho" 0)
  (vl-load-com)
  (defun #err4 (s)
    (command ".UNDO" "E")
    (command "select" ssbak "")
    (vl-exit-with-error "")
    (setq *error* $orr)
  )
  (setq $orr *error*)
  (setq *error* #err4)
  (setq ss (ssget))
  (if (null ss)
    (vl-exit-with-error "")
  )
  (setq p0 (getpoint "\n指定复制基点:"))
  (if (null p0)
    (vl-exit-with-error "")
  )
  (princ "\n指定第二点, 或输入位移距离:")
  (while t
    (command ".UNDO" "BE")
    (setq ennn (entlast))
    (command ".copy" ss "" p0 pause)

    (setq p1 (getvar "lastpoint"))

    (setq juli (distance p0 p1))
    (setq P0 P1)
    (if        (= 0 juli)
      ;;-----------------------------------------------
      (progn
        (command ".UNDO" "1")
        (command "select" ssbak "")
        (vl-exit-with-error "")
        (princ)
      )
      ;;-----------------------------------------------
      (progn
        (setq ssbak (lt:ss-entnext ennn))
        (setq ss ssbak)
        (princ "\n指定下一点, 或输入位移距离:"
        )
      )
      ;;-----------------------------------------------
    )
    (command ".UNDO" "E")
  )
  (setq *error* $orr)
  (princ)
)
;;; _____________________________________________________________
;;; ▓ (lt:ss-entnext en)
;;; [功能] 获取在图元 en 之后产生的图元的选择集
;;; [参数] en----图元名
;;; [返回] 选择集
;;; [测试]1.(setq en (entlast))
;;;         执行创建图元的命令，如 line,boundary
;;;         (setq ss (lt:ss-entnext en))
;;;       2.(setq ss (lt:ss-entnext (car(entsel))))
(defun lt:ss-entnext (en / ss)
  (if en
    (progn
      (setq ss (ssadd))
      (while (setq en (entnext en))
        (if (not (member (cdr (assoc 0 (entget en)))
                         '("ATTRIB"
                           "VERTEX"
                           "SEQEND"
                          )
                 )
            )
          (ssadd en ss)
        )
      )
      (if (zerop (sslength ss))
        (setq ss nil)
      )
      ss
    )
    (ssget "_x")
  )
)

wowan1314

谢谢分享！

doro

好东西 先收藏

注册

适合自己的就是最好的

fdb2007

谢谢分享！

梦醒才知原是梦

谢谢分享，收藏以后学习~

清风明月名字

谢谢楼主，值得学习