构建内部区域相连的实体选择集

marting · 发表于 2017-9-8 14:18:15

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:tt (/ ap e fz p pts)
(setq e (entlast))
(setq fz 1)
(if (and (setq p (getpoint "\nPick internal point: "))
(not (command "_.-boundary" "a" "o" "p" "" p ""))
(not (equal e (entlast)))
)
(progn
(setq pts (mapcar 'cdr
(vl-remove-if-not
'(lambda (x) (= 10 (car x)))
(entget (entlast))
)
)
)
(entdel (entlast))
(setq ap (mapcar '(lambda (x) (/ x (length pts)))
(apply 'mapcar (cons '+ pts))
)
)
(sssetfirst
nil
(ssget
"_CP"
(mapcar
'(lambda (x) (polar ap (angle ap x) (+ fz (distance ap x))))
pts
)
)
)
)
)
(princ)
)

(defun c:tt (/ ap e fz p pts) 
  (setq e (entlast)) 
  (setq fz 1) 
  (if (and (setq p (getpoint "\nPick internal point: ")) 
           (not (command "_.-boundary" "a" "o" "p" "" p "")) 
           (not (equal e (entlast))) 
      ) 
    (progn 
      (setq pts        (mapcar        'cdr 
                        (vl-remove-if-not 
                          '(lambda (x) (= 10 (car x))) 
                          (entget (entlast)) 
                        ) 
                ) 
      ) 
      (entdel (entlast)) 
      (setq ap (mapcar '(lambda (x) (/ x (length pts))) 
                       (apply 'mapcar (cons '+ pts)) 
               ) 
      ) 
      (sssetfirst 
        nil 
        (ssget 
          "_CP" 
          (mapcar 
            '(lambda (x) (polar ap (angle ap x) (+ fz (distance ap x)))) 
            pts 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

434939575 · 发表于 2017-9-8 14:33:01

这个好，mapcar专家

sh_h · 发表于 2017-9-8 15:03:24

谢谢 marting 大师分享！！！

ynhh · 发表于 2017-9-8 22:27:02

慢慢看
才知道这很高大上

就不知用在什么地方啊

liunian0524 · 发表于 2017-9-9 08:26:51

感谢大师分享

zjy2999 · 发表于 2017-9-9 21:22:18

谢谢！！！！！

kqqt6236 · 发表于 2017-9-11 00:08:33

学习源码。

yoyoho · 发表于 2018-2-12 09:59:31

谢谢 marting 大师分享！！！！！

kqqt6236 · 发表于 2018-2-13 11:36:17

可以把这个变成一个可以调用的函数吗？

账号		自动登录	找回密码
密码			立即注册

[每日一码] 构建内部区域相连的实体选择集

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。