[编程交流] “3D”矩形

(defun c:3DRect ( / doc firstP normal pt1 pt2 pt3 pt4)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc) ; End open undo group.
 (vla-startundomark doc)
 (if
   (and
     (setq pt1 (getpoint "\nFirst corner: "))
     (setq pt3 (getpoint pt1 "\nOther corner: "))
     (setq normal
       (mapcar '(lambda (a b) (if (equal a b 1e- 1 0)) pt1 pt3)
     )
     (= 1 (apply '+ normal))
   )
   (progn
     (setq pt2
       (mapcar
         '(lambda (n a b)
           (cond ((= 1 n) a) ((setq firstP (not firstP)) a) (b))
         )
         normal
         pt1
         pt3
       )
     )
     (setq pt4
       (mapcar
         '(lambda (n a b)
           (cond ((= 1 n) a) ((setq firstP (not firstP)) a) (b))
         )
         normal
         pt3
         pt1
       )
     )
     (setq normal (trans normal 1 0 T))
     (entmake
       (list
         '(0 . "LWPOLYLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbPolyline")
         '(90 . 4)
         (cons 70 (+ 1 (* (getvar 'plinegen) 128)))
         (cons 43 (getvar 'plinewid))
         (cons 38 (caddr (trans pt1 1 normal))) ; Elevation.
         (cons 39 (getvar 'thickness))
         (cons 10 (trans pt1 1 normal))
         (cons 10 (trans pt2 1 normal))
         (cons 10 (trans pt3 1 normal))
         (cons 10 (trans pt4 1 normal))
         (cons 210 normal)
       )
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

(defun c:3DRect ( / v^v unit doc normal pt1 pt2 pt3 pt4 )
 (vl-load-com)
 (defun v^v ( u v )
   (list
     (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
     (- (* (caddr u) (car v)) (* (car u) (caddr v)))
     (- (* (car u) (cadr v)) (* (cadr u) (car v)))
   )
 )
 (defun unit ( v )
   (if (not (equal v '(0.0 0.0 0.0) 1e-)
     (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
   )
 )
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc) ; End open undo group.
 (vla-startundomark doc)
 (if
   (and
     (setq pt1 (trans (getpoint "\nFirst corner : ") 1 0))
     (setq pt3 (trans (getpoint (trans pt1 0 1) "\nOther corner : ") 1 0))
     (setq normal (unit (v^v '(0.0 0.0 1.0) (mapcar '- pt3 pt1))))
   )
   (progn
     (setq pt2 (inters pt1 (mapcar '+ pt1 (v^v normal (append (mapcar '+ '(0.0 0.0) (mapcar '- pt3 pt1)) (list 0.0)))) pt3 (mapcar '+ pt3 (append (mapcar '+ '(0.0 0.0) (mapcar '- pt1 pt3)) (list 0.0))) nil))
     (setq pt4 (inters pt3 (mapcar '+ pt3 (v^v normal (append (mapcar '+ '(0.0 0.0) (mapcar '- pt1 pt3)) (list 0.0)))) pt1 (mapcar '+ pt1 (append (mapcar '+ '(0.0 0.0) (mapcar '- pt3 pt1)) (list 0.0))) nil))
     (entmake
       (list
         '(0 . "LWPOLYLINE")
         '(100 . "AcDbEntity")
         '(100 . "AcDbPolyline")
         '(90 . 4)
         (cons 70 (+ 1 (* (getvar 'plinegen) 128)))
         (cons 43 (getvar 'plinewid))
         (cons 38 (caddr (trans pt1 0 normal))) ; Elevation.
         (cons 39 (getvar 'thickness))
         (cons 10 (trans pt1 0 normal))
         (cons 10 (trans pt2 0 normal))
         (cons 10 (trans pt3 0 normal))
         (cons 10 (trans pt4 0 normal))
         (cons 210 normal)
       )
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

(setq pt2 (list (car pt1) (cadr pt1) (caddr pt3)))
(setq pt4 (list (car pt3) (cadr pt3) (caddr pt1)))