高仿ALIGN命令

highflybird 周五, 09/07/2012 - 10:30

CAD中平齐物体的实现是通过align命令来实现的。
但在CAD编程中有时候需要对这个命令自定义，而且在某些情况下不适合用命令形式。
所以我编写了一个lisp程序，用户也可以根据这个程序定义更高级的平齐。
下面是实现的代码。

;;;-----------------------------------------------------------;;
;;; To simulate the command: "align"                          ;;
;;; Command:Align3d                                           ;;
;;; Use in some cases: command can't be applied or you don't  ;;
;;; want to use them; or improve the efficiency,etc.and here  ;;
;;; are some useful functions,e.g. "Mat:Get3PMatrix";Or even  ;;
;;; you can customize "align" command.                        ;;
;;; Author: Highflybird, Date:2012-8-6.                       ;;
;;; All copyrights reserved.                                  ;;
;;;-----------------------------------------------------------;;
(defun C:Align3d (/ sel sP1 sP2 sP3 dP1 dP2 dP3 sclp scl
                    mat0 mat1 mat2 mat i ent obj app doc)
  ;;input
  (setq sel (ssget))
  (initget 9)
  (setq sP1 (getpoint "nSpecify first source point:"))
  (initget 9)
  (setq dP1 (getpoint "nSpecify first destination point:"))
  (initget 9)
  (setq sP2 (getpoint "nSpecify second source point:"))
  (initget 9)
  (setq dP2 (getpoint "nSpecify second destination point:"))
  (initget 8)
  (setq sP3 (getpoint "nSpecify third source point or :"))
  (initget 9)
  (if (null sP3)
    (setq sP3 (Mat:Rotate90 sP2 sP1)
          dP3 (Mat:Rotate90 dP2 dP1)
    )
    (setq dP3 (getpoint "nSpecify third destination point:"))
  )
  (foreach x '(sP1 sP2 sP3 dP1 dP2 dP3)
    (set x (trans (eval x) 1 0))
  )
  (initget "Yes No")
  (setq sclp (getkword "nScale objects based on alignment points? [Yes/No] :"))
  ;;Get the transformation matrix
  (setq mat1 (Mat:3PMatrix sP1 sP2 sP3 nil))
  (setq mat2 (Mat:3PMatrix dP1 dP2 dP3 T))
  (if (= "Yes" sclp)
    (setq scl (/ (distance dP1 dP2) (distance sP2 sP1))
          mat0 (list (list scl 0 0 0)(list 0 scl 0 0) (list 0 0 scl 0) '(0 0 0 1))
          mat (Mat:mxm mat2 (Mat:mxm mat0 mat1))
    )
    (setq mat (Mat:mxm mat2 mat1))
  )
  ;;Apply the transformation.
  (setq app (vlax-get-acad-object))
  (setq doc (vla-get-ActiveDocument app))
  (vla-StartUndoMark doc)
  (setq i 0)
  (if sel
    (repeat (sslength sel)
      (setq ent (ssname sel i))
      (setq obj (vlax-ename->vla-object ent))
      (vla-transformby obj (vlax-tmatrix mat))
      (setq i (1+ i))
    )
  )
  (vla-EndUndoMark doc)
  (vlax-release-object doc)
  (vlax-release-object app)
  (princ)
)
;;;-----------------------------------------------------------;;
;;; Mat:Rotate90 Rotate a point 90 degree by a basepoint      ;;
;;;-----------------------------------------------------------;;
(defun Mat:Rotate90 (Pt BasePt / a)
  (setq a (+ (/ pi 2) (angle BasePt Pt)))
  (polar BasePt a (distance pt basePt))
)
(prompt "Command is: Align3d")
(princ)
编程