smartstar 发表于 2012-5-5 16:21:50

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

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

第一个：两点中点的垂线镜像图元（镜像后的图元设定为“上一个选集”）
(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 发表于 2012-5-5 16:29:52

谢谢分享！

doro 发表于 2012-5-5 18:02:25

好东西 先收藏

注册 发表于 2012-5-5 19:34:06

适合自己的就是最好的

fdb2007 发表于 2012-5-6 14:33:28

谢谢分享！

梦醒才知原是梦 发表于 2012-5-10 16:11:11

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

清风明月名字 发表于 2012-5-12 12:11:10

谢谢楼主，值得学习
页: [1]
查看完整版本: 自己常用的几个AutoCAD改进命令