社区 › Auto Lisp › 开放多边形的重心

anishtain4 发表于 2022-7-6 08:35:03

开放多边形的重心

有人有嘴唇可以定位开放多段线的线的重心吗？

Stefan BMR 发表于 2022-7-6 08:45:45

如果pline没有圆弧，这应该可以工作
(defun c:cgpline (/ dst lst mdp mdx mdy ss x y en pt)
(if
   (setq ss (ssget ":E:S:L" '((0 . "LWPOLYLINE"))))
    (progn
      (setq lst (mapcar 'cdr
                        (vl-remove-if
                        '(lambda (x) (/= (car x) 10))
                        (setq en (entget (ssname ss 0)))
                        )
                )
            dst (mapcar 'distance lst (cdr lst))
            mdp (mapcar '(lambda (x y)
                           (mapcar '(lambda (a b) (* 0.5 (+ a b))) x y)
                         )
                        lst
                        (cdr lst)
                )
            mdx (mapcar 'car mdp)
            mdy (mapcar 'cadr mdp)
            x   (/ (apply '+ (mapcar '* mdx dst)) (apply '+ dst))
            y   (/ (apply '+ (mapcar '* mdy dst)) (apply '+ dst))
            pt(trans (list x
                           y
                           (cond ((cdr (assoc 38 en)))
                                 (0.0)
                           )
                     )
                     (trans '(0. 0. 1.) (cdr (assoc 210 en)) 0 T)
                     0
                )
      )
      (entmake (list '(0 . "POINT") (cons 10 pt)))
    )
)
(princ)
)

Lee Mac 发表于 2022-7-6 08:51:30

http://www.theswamp.org/index.php?topic=18725.0

Tharwat 发表于 2022-7-6 08:55:52

@斯特凡。我认为你的程序没有给正确的中心点一条折线。
 
我的版本。。。。使用窗口选择集，这意味着一次关闭可以选择多少。
 

(defun c:TesT (/ pl i sn e lst pts n i x y)
;;; Tharwat 12. Dec. 2011 ;;
(if (setq pl (ssget '((0 . "*POLYLINE"))))
   (repeat (setq i (sslength pl))
   (setq sn (ssname pl (setq i (1- i))))
   (setq e (entget sn))
   (setq lst (vl-remove-if-not
               (function (lambda (x)
                           (if (eq (car x) 10)
                               (setq pts (cons (list (cadr x) (caddr x)) pts))
                           )
                           )
               )
               e
               )
   )
   (setq i 0 x 0 y 0 )
   (repeat (setq n (length pts))
       (setq x (+ (car (nth i pts)) x))
       (setq y (+ (cadr (nth i pts)) y))
       (setq i (1+ i))
   )
   (entmake (list '(0 . "POINT") (cons 10 (list (/ x (length pts)) (/ y (length pts))))))
   )
   (princ)
)
(princ)
)

Lee Mac 发表于 2022-7-6 09:06:00

骗子的方式：
 
Tharwat，我看不出有什么意义：
 
(setq lst (vl-remove-if-not
         (function (lambda (x)
                     (if (eq (car x) 10)
                         (setq pts (cons (list (cadr x) (caddr x)) pts))
                     )
                     )
         )
         e
         )
)

Tharwat 发表于 2022-7-6 09:08:38

 
我确信你知道每一段代码，如果你指出两个变量的名字，实际上我只想得到没有前10个变量的坐标。
 
顺便问一下，你看到这个请求了吗？
 
谢谢

Lee Mac 发表于 2022-7-6 09:16:27

 
我的意思是，使用vl remove if not函数是多余的，因为您没有使用返回的列表（变量“lst”）。
 
请考虑以下内容：
 
(foreach pair (entget <entity>)
   (if (= 10 (car pair))
       (setq pts (cons (cdr pair) pts))
   )
)

Stefan BMR 发表于 2022-7-6 09:21:48

我认为OP想要轮廓的重心，像一条非常非常细的线。。。
 
我可能错了，那么我的观点确实算错了。
在Lee给出的链接中，Evgeniy给出了三种计算重心的方法：
1） 对于一个区域
2） 对于大纲
3） 对于集中在节点中的质量
 
我的计算重心与第二个一样。
 
另一方面，我试过你的Lisp程序和李的。。。结果不同。。。
 
编辑：Tharwat，您的例程是计算顶点位置的媒体，而不是重心。

Tharwat 发表于 2022-7-6 09:31:20

 
是的，除此之外，我们还可以在相同的情况下使用mapcar函数。
 
(mapcar
       (function
         (lambda (x)
         (if (eq (car x) 10)
             (setq pts (cons (list (cadr x) (caddr x)) pts))
         )
         )
       )
       e
   )

 
非常感谢。

Lee Mac 发表于 2022-7-6 09:35:34

我上面的代码是返回质心，Tharwat只是平均我认为只适用于正多边形和三角形的点。
 
以下是返回LWPolyline多边形质心的另一种方法：
 
6
 
以上返回的结果与我之前的代码（使用区域）相同，与链接线程中的gile代码相同，用于LWPolyline多边形（即具有直线段的非自交LWPolyline）。

查看完整版本: 开放多边形的重心