2019-09-08 填充算法,测试.LSP

分类:lisp函数 | 标签: lisp   填充  
2019-09-08 18:03 阅读(?)评论(0)

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)
 
表  情:
加载中...
 

请各位遵纪守法并注意语言文明