[编程交流] 画一个三角形

(defun c:triang120 ( / unit mxv v^v transptucs transptwcs p1 p2 loop g p h gp p3 )
 (defun unit ( v / d )
   (mapcar '(lambda ( x y ) (/ x y)) v (list (setq d (distance '(0.0 0.0 0.0) v)) d d))
 )
 (defun mxv ( m v )
   (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
 )
 (defun v^v ( u v )
   (list
     (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
     (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
     (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
   )
 )
 (defun transptucs ( pt p1 p2 p3 / ux uy uz )
   (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
   (setq ux (unit (mapcar '- p2 p1)))
   (setq uy (unit (mapcar '- p3 p1)))
   
   (mxv (list ux uy uz) (mapcar '- pt p1))
 )
 (defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
   (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
   (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
   (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
   (transptucs pt pt1n pt2n pt3n)
 )
 (setq p1 (getpoint "\nPick or specify start point : "))
 (setq p2 (getpoint "\nPick or specify end point : " p1))
 (setq loop t)
 (while loop
   (setq g (grread t 15 0))
   (if (eq (car g) 5)
     (progn
       (setq p (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
       (setq h (/ (distance p1 p2) (* 2.0 (sqrt 3.0))))
       (setq gp (cadr g))
       (if (not (minusp (cadr (transptucs gp p1 (polar p1 (angle p1 p2) 1.0) (polar p1 (+ (angle p1 p2) (* 0.5 pi)) 1.0)))))
         (progn
           (redraw)
           (setq p3 (polar p (+ (angle p1 p2) (* 0.5 pi)) h))
           (grdraw p1 p2 1 1)
           (grdraw p2 p3 1 1)
           (grdraw p3 p1 1 1)
         )
         (progn
           (redraw)
           (setq p3 (polar p (- (angle p1 p2) (* 0.5 pi)) h))
           (grdraw p1 p2 1 1)
           (grdraw p2 p3 1 1)
           (grdraw p3 p1 1 1)
         )
       )
     )
     (progn
       (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 3) (if (eq (getvar 'plinegen) 1) '(70 . 129) '(70 . 1)) (cons 38 (caddr (trans p1 1 (trans '(0.0 0.0 1.0) 1 0 t)))) (cons 10 (list (car (trans p1 1 (trans '(0.0 0.0 1.0) 1 0 t))) (cadr (trans p1 1 (trans '(0.0 0.0 1.0) 1 0 t))))) (cons 10 (list (car (trans p2 1 (trans '(0.0 0.0 1.0) 1 0 t))) (cadr (trans p2 1 (trans '(0.0 0.0 1.0) 1 0 t))))) (cons 10 (list (car (trans p3 1 (trans '(0.0 0.0 1.0) 1 0 t))) (cadr (trans p3 1 (trans '(0.0 0.0 1.0) 1 0 t))))) (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))))
       (setq loop nil)
     )
   )
 )
 (redraw)
 (princ)
)

(defun c:2ptri ( / d1 d2 p1 p2 p3 p4 p5 v1 v2 x1 )
   (if (and (setq p1 (getpoint "\n1st point: "))
            (setq p2 (getpoint "\n2nd point: " p1))
            (setq v1 (trans  (mapcar '- p1 p2) 1 0 t)
                  v2 (trans '(0 0 1) 1 0 t)
                  d1 (/ (distance p1 p2) 2)
                  d2 (/ d1 (sqrt 3))
                  p3 (trans p1 1 v1)
                  x1 (car p3)
            )
            (progn
                (while (= 5 (car (setq p4 (grread t 13 0))))
                    (redraw)
                    (setq p5 (trans (list ((if (< x1 (car (trans (cadr p4) 1 v1))) + -) x1 d2) (cadr p3) (- (caddr p3) d1)) v1 1))
                    (grdraw p1 p2 1 1)
                    (grdraw p1 p5 1 1)
                    (grdraw p2 p5 1 1)
                )
                (list (cadr p4))
            )
        )
        (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 3)
               '(070 . 1)
                (cons 010 (trans p1 1 v2))
                (cons 010 (trans p2 1 v2))
                (cons 010 (trans p5 1 v2))
                (cons 210 v2)
            )
        )
   )
   (redraw) (princ)
)