将多边形坐标转换为

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一样，因为“关闭”是代码的一部分，所以不需要最后一个点。

copy


; 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/[/img]-VB网站，由www.andypope托管。信息已被报告为不安全！

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

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

copy


                                        ; 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

copy


(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>

copy

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

我在我的帖子中更新了代码，但平均defun更好，因为points正在尝试使用mapcar等做同样的事情。将保存它以供将来参考。

如果使用appload、drag drop或menu load，则有一个输入错误（c:clpoints）应该是（c:plpoints）straighaway。

[编程交流] 将多边形坐标转换为

发表回复

精选推荐