画一个三角形
拿起两点，画一个三角形，120度等腰三角形。您不需要lisp例程。将“多边形”命令与“边”选项一起使用。
这里有一个lisp例程来绘制三角形。您可能需要修改它以满足您的需要。
三角形。lsp
资料来源：CADTutor，2008年3月4日；作者：muck。 也许是这样：
(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)))
(- (* (carv) (caddr u)) (* (caru) (caddr v)))
(- (* (caru) (cadrv)) (* (carv) (cadru)))
)
)
(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)
)
M、 R。 另一个，对于平行于WCS的平面：
(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)
) 马科，李，非常感谢！ 不客气！
页:
[1]