BIGAL 发表于 2022-7-6 22:02:27

LRM很酷，使用图形显示结果添加了make pline位，只需复制并粘贴到Autocad J1-J6即可

amir0914 发表于 2022-7-6 22:07:32

太棒了，非常感谢。
宏解决了我的问题，但是如果将来的点数超过4点，宏会工作吗？（例如10分）。就像这样：
 

BIGAL 发表于 2022-7-6 22:09:00

您应该张贴xls以备将来测试。
 
无论如何，只要你总是有一个凸的形状，这应该工作。它观察点的内角，所以不需要图形的etc，H模式将不起作用。
 
在excel单元格中使用F2=（连接（“点”，B2，“，”，C2），然后向下复制并粘贴，就像样本F2-F11一样，因为“关闭”是代码的一部分，所以不需要最后一个点。 
 

; pline around points
; By AlanH info@alanh.com.au
: June 2020

(vl-load-com)

(defun c:plpoints ( / ss pt pts x ent lst)
(setq ss (ssget (list (cons 0 "POINT"))))
(setq pt (getpoint "pick center point"))
(setq lst '())
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (- x 1))))
(setq pts (cdr (assoc 10 (entget ent))))
(setq lst (cons (list (angle pts pt) (list (car pts)(cadr pts))) lst))
)
(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))
(entmakex (append (list(cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90 (length lst))
                         (cons 70 1))
                   (mapcar (function (lambda (p) (cons 10 (nth 1 p)))) lst))
)
(princ)
)

(c:clpoints)

lrm 发表于 2022-7-6 22:13:10

 
@amir0914不，我的程序只适用于4分。
 
@比加尔很漂亮！！！
 
如果OP处理的点都是凸包的一部分，则可以修改代码，将中心点定义为点集的质心，从而无需用户指定中心点。
 

BIGAL 发表于 2022-7-6 22:16:27

想给最终用户留下一些东西来添加，我确实想过，但更多的代码。注意这个地方。
 
是的，代码更新了。

hanhphuc 发表于 2022-7-6 22:20:08

 
LISP try LM:ConvexHull
或
卓越论坛https://lebim.cn/a/-VB网站，由www.andypope托管。信息已被报告为不安全！ 
 
 
 

amir0914 发表于 2022-7-6 22:21:04

 
这真是个好主意，我把它改了一点，用平均点来寻找中心点：（只在规则形状上）

                                        ; pline around points
                                        ; By AlanH info@alanh.com.au
:
June
2020

(vl-load-com)

(defun c:plpoints (/ ss pt pts x ent lst)
(setq ss (ssget (list (cons 0 "POINT"))))

(setq ptlist nil)
(repeat (setq x (sslength ss))
    (setq ent (ssname ss (setq x (- x 1))))
    (setq pts (cdr (assoc 10 (entget ent))))
    (setq ptlist (cons pts ptlist))
    (setq pt (average ptlist))
)

;;;(setq pt (getpoint "pick center point"))

(setq lst '())

(foreach a ptlist
    (setq
      lst (cons (list (angle a pt) (list (car a) (cadr a))) lst)
    )
)

(setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y)))))
(entmakex
    (append (list (cons 0 "LWPOLYLINE")
                  (cons 100 "AcDbEntity")
                  (cons 100 "AcDbPolyline")
                  (cons 90 (length lst))
                  (cons 70 1)
          )
          (mapcar (function (lambda (p) (cons 10 (nth 1 p)))) lst)
    )
)
(princ)
)

(c:clpoints)


(defun average (lst)
(mapcar '(lambda (x) (/ x (length lst)))
          (apply 'mapcar (cons '+ lst))
)
)

amir0914 发表于 2022-7-6 22:26:51

 

hanhphuc 发表于 2022-7-6 22:30:16

 
作者已经发表了很好的评论，所以只需省略sub m_AddPaddingPoints



(Public Function CalculateHull () As Boolean

;<snippet>

'
' Use the hull points as the set of value to check
' adding an extra set of points
'
             <s>  m_AddPaddingPoints</s>
                blnAnimate = m_blnAnimate

;<snippet>   

               
 


 

BIGAL 发表于 2022-7-6 22:30:53

我在我的帖子中更新了代码，但平均defun更好，因为points正在尝试使用mapcar等做同样的事情。将保存它以供将来参考。
 
如果使用appload、drag drop或menu load，则有一个输入错误（c:clpoints）应该是（c:plpoints）straighaway。
 
 
页: 1 [2]
查看完整版本: 将多边形坐标转换为