API应用对相同曲线编号

st788796 · 发表于 2014-3-15 10:31:18

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

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

×

对复制的曲线，可以是不同角度

(defun c:tt (/ ss lst)
(if (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1))))
(progn
(setq
lst (mapcar '(lambda (x)
(list (cons (xdrx_polyline_numverts x)
(mapcar '(lambda (a)
(apply 'distance a)
)
(XD::List:SnakePair
(xdrx_getpropertyvalue
x
"Vertices"
)
)
)
)
x
)
)
(xdrx_pickset->ents ss)
)
lst (XD::List:GroupByIndex lst 1e-3)
i 0
)
(mapcar
'(lambda (x)
(setq i (1+ i))
(mapcar '(lambda (a)
(xdrx_text_make
(apply 'xdrx_points_centroid (xdrx_entity_box a))
(itoa i)
2.5
0.
)
)
x
)
)
(mapcar 'cdr lst)
)
)
)
(princ)
)

(defun c:tt (/ ss lst) 
  (if (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1)))) 
    (progn 
      (setq 
        lst (mapcar '(lambda (x) 
                       (list (cons (xdrx_polyline_numverts x) 
                                   (mapcar '(lambda (a) 
                                             (apply 'distance a) 
                                           ) 
                                           (XD::List:SnakePair 
                                             (xdrx_getpropertyvalue 
                                               x 
                                               "Vertices" 
                                             ) 
                                           ) 
                                   ) 
                             ) 
                             x 
                       ) 
                     ) 
                    (xdrx_pickset->ents ss) 
            ) 
        lst (XD::List:GroupByIndex lst 1e-3) 
        i   0 
      ) 
      (mapcar 
        '(lambda (x) 
           (setq i (1+ i)) 
           (mapcar '(lambda (a) 
                      (xdrx_text_make 
                        (apply 'xdrx_points_centroid (xdrx_entity_box a)) 
                        (itoa i) 
                        2.5 
                        0. 
                      ) 
                    ) 
                   x 
           ) 
         ) 
        (mapcar 'cdr lst) 
      ) 
    ) 
  ) 
  (princ) 
)

st788796 · 发表于 2014-3-15 11:20:37

纯 Lisp 版 XD::List:GroupByIndex 到函数发布搜索

(defun c:tt (/ ss i el)
(if (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1))))
(progn
(setq i (sslength ss))
(while (setq e (ssname ss (setq i (1- i))))
(setq el (cons (entget e) el))
)
(setq el (mapcar '(lambda (x / pts lst)
(setq pts (mapcar
'cdr
(vl-remove-if '(lambda (a) (/= (car a) 10)) x)
)
pts (cons (last pts) pts)
lst (mapcar '(lambda (a b)
(distance a b)
)
pts
(cdr pts)
)
)
(list (cons (cdr (assoc 90 x)) lst)
pts
)
)
el
)
el (XD::List:GroupByIndex el 1e-3)
i 0
)
(mapcar '(lambda (x)
(setq i (1+ i))
(mapcar '(lambda (a / l p)
(setq l (length a)
p (list (/ (apply '+ (mapcar 'car a)) l)
(/ (apply '+ (mapcar 'cadr a)) l)
0.
)
)
(entmake (list '(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 1 (itoa i))
(cons 10 p)
(cons 40 2.5)
'(50 . 0)
)
)
)
x
)
)
(mapcar 'cdr el)
)
)
)
(princ)
)

(defun c:tt (/ ss i el) 
  (if (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1)))) 
    (progn 
      (setq i (sslength ss)) 
      (while (setq e (ssname ss (setq i (1- i)))) 
        (setq el (cons (entget e) el)) 
      ) 
      (setq el (mapcar '(lambda        (x / pts lst) 
                          (setq        pts (mapcar 
                                      'cdr 
                                      (vl-remove-if '(lambda (a) (/= (car a) 10)) x) 
                                    ) 
                                pts (cons (last pts) pts) 
                                lst (mapcar '(lambda (a b) 
                                               (distance a b) 
                                             ) 
                                            pts 
                                            (cdr pts) 
                                    ) 
                          ) 
                          (list        (cons (cdr (assoc 90 x)) lst) 
                                pts 
                          ) 
                        ) 
                       el 
               ) 
            el (XD::List:GroupByIndex el 1e-3) 
            i  0 
      ) 
      (mapcar '(lambda (x) 
                 (setq i (1+ i)) 
                 (mapcar '(lambda (a / l p) 
                            (setq l (length a) 
                                  p (list (/ (apply '+ (mapcar 'car a)) l) 
                                          (/ (apply '+ (mapcar 'cadr a)) l) 
                                          0. 
                                    ) 
                            ) 
                            (entmake (list '(0 . "TEXT") 
                                           '(100 . "AcDbEntity") 
                                           '(100 . "AcDbText") 
                                           (cons 1 (itoa i)) 
                                           (cons 10 p) 
                                           (cons 40 2.5) 
                                           '(50 . 0) 
                                     ) 
                            ) 
                          ) 
                         x 
                 ) 
               ) 
              (mapcar 'cdr el) 
      ) 
    ) 
  ) 
  (princ) 
)

hzj268 · 发表于 2014-3-15 13:55:35

本帖最后由 hzj268 于 2014-3-15 14:42 编辑

老大最近不知道怎么了我复制代码后会出现代码前面都是问号？？？情况我不知道什么原因，

hzj268 · 发表于 2014-3-16 09:18:21

已解决和复制的方式有关系

st788796 · 发表于 2014-3-17 11:42:31

应该再加一个面积参数，比如矩形和平行四边形边长全等时不一定是全等多边形

清风明月10 · 发表于 2014-4-16 20:24:14

谢谢楼主！又学一招。

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

[教学] API应用 对相同曲线编号

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

[教学] API应用对相同曲线编号