日志正文
|
||
2019-09-08 填充算法,测试.LSP;;;=================================================================* ;;;测试 (defun c:tt (/ pt0 pt1 pt2) (if (and (setq pt0 (getpoint "\n点取第一点: ")) (setq pt1 (getpoint pt0 "\n点取第二点: ")) (setq pt2 (getpoint pt1 "\n点取第三点: ")) ) (fun-test pt0 pt1 pt2) ) ) ;;;=================================================================* ;;;功能:涂抹三点之间的区域。 * ;;;参数:pt0 ----- 角点0 * ;;; pt1 ----- 角点1 * ;;; pt2 ----- 角点2 * ;;;日期:zml84 于 2019-09-08 * (defun fun-test (pt0 pt1 pt2 / tmp_x tmp_y x_min x_max y_min y_max y lst pta ptb tmp x0 x1 ) ;; 1、 (setq tmp_x (mapcar 'car (list pt0 pt1 pt2)) tmp_y (mapcar 'cadr (list pt0 pt1 pt2)) ) (setq x_min (apply 'min tmp_x) x_max (apply 'max tmp_x) y_min (apply 'min tmp_y) y_max (apply 'max tmp_y) ) ;; 2、 (setq y (fix y_min)) (while (<= y y_max) (setq lst '() pta (list x_min y) ptb (list x_max y) ) (if (setq tmp (inters pta ptb pt0 pt1)) (setq lst (cons (car tmp) lst)) ) (if (setq tmp (inters pta ptb pt1 pt2)) (setq lst (cons (car tmp) lst)) ) (if (setq tmp (inters pta ptb pt2 pt0)) (setq lst (cons (car tmp) lst)) ) (if lst (progn (setq x0 (fix (+ 0.5 (apply 'min lst))) x1 (fix (+ 0.5 (apply 'max lst))) ) (entmake (list '(0 . "LINE") '(100 . "AcDbLine") '(8 . "0") '(62 . 3) (list 10 x0 y) (list 11 x1 y) '(210 0.0 0.0 1.0) ) ) ) ) (setq y (1+ y)) ) )
最后修改于 2020-02-03 14:38
阅读(?)评论(0)
上一篇: 通用函数 算法 拟合圆弧(非精确).LSP
下一篇:帮忙处理字符串.lsp
|
||
评论 想第一时间抢沙发么?