如何用对话框来控制四边形倒角

XDSoft

sicky111 发表于 2013-5-13 23:16
非常感谢，但是测试还是有问题。错误: 参数类型错误: lselsetp nil
只有新开图档第一次默认倒左上角的R ...

程序开发中，点的“排序”是很重要的，给你个思路，你要自己写个函数，就是不管什么情况，你能保证你需要的点是按固定要求排序好的。

比如你的四边形，你要找到X最小，Y最小的点 作为表的第一个点，然后把多边形的点从这个点开始逆时针排序。

这样以后应用的时候，你就知道哪个点是什么位置了，比如上面，第一个点就是左下点（你认为的），第二个就是右下点。。。。
给你个我的函数库里面的函数，里面有XDRX_API的函数，不过是排序函数，你可以根据思路，用VL-SORT替代它。

[pcode=lisp,true]
;|
   返回点表的X最小，Y最小
|;
(defun $XDLSP_Points_MinX->MinY (pts / ptl box n disy disx old new ptl)
  (setq box (apply
              'xdrx_pointsbox
              pts
            )
  )
  (if (not (xdrx_iswcs))
    (setq box ($XDLSP_Points_ucs2wcs ($XDLSP_Points_AddZ box 0.0)))
  )
  (foreach n pts
    (setq disy (abs (xdrx_p2ldist n (car box) (cadr box)))
          disx (abs (xdrx_p2ldist n (car box) (last box)))
          disx (atof (rtos disx 2 3))
          disy (atof (rtos disy 2 3))
    )
    (if (setq old (assoc disx ptl))
      (progn
        (setq new (list disx (cons (list disy n) (cadr old)))
              ptl (subst
                    new
                    old
                    ptl
                  )
        )
      )
      (progn
        (setq ptl (cons (list disx (list (list disy n))) ptl))
      )
    )
  )
  (cadar (apply
           'xdrx_rlistsort2
           (cadar (apply
                    'xdrx_rlistsort2
                    ptl
                  )
           )
         )
  )
)

[/pcode]

牢固

sicky111 发表于 2013-5-13 23:05
G版您好，我现在只考虑水平的四边形，不考虑带斜度的，如果有带斜度，可以先将四边形转正，倒完角后再旋 ...

四边形即使是倾斜的，13楼已给出判断的明示！

Free-Lancer

[pcode=lisp,true](defun Pts:Minxy (pts)
  (car (vl-sort        pts
                '(lambda (e1 e2)
                   (if (equal (car e1) (car e2) 1e-10)
                     (< (cadr e1) (cadr e2))
                     (< (car e1) (car e2))
                   )
                 )
       )
  )
)[/pcode]

Free-Lancer

对旋转的或者多边形，好像这个更符合题意（Y最小、X最小），楼上的函数是获取点集最左侧的点

1. (defun Pts:MinXY (pts / miny)
   
2.   (setq        miny (apply 'min (mapcar 'cadr pts))
   
3.         pts  (vl-remove-if '(lambda (x) (/= (cadr x) miny)) pts) ;_Points of MinY
   
4.   )
   
5.   (if (= (length pts) 1)
   
6.     (car pts)
   
7.     (car (vl-sort pts (lambda (a b) (< (car a) (car b))))) ;_MinX+MinY
   
8.   )
   
9. )

(defun Pts:MinXY (pts / miny)<br />   (setq        miny (apply 'min (mapcar 'cadr pts))<br />         pts  (vl-remove-if '(lambda (x) (/= (cadr x) miny)) pts) ;_Points of MinY<br />   )<br />   (if (= (length pts) 1)<br />     (car pts)<br />     (car (vl-sort pts (lambda (a b) (< (car a) (car b))))) ;_MinX+MinY<br />   )<br /> )