API应用一个区域编号应用

eachy · 发表于 2014-3-27 14:22:47

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

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

×

随便写了一个，不知道哪里用得到，提供一个思路，后面用 XD::Table:Make 还可以完成表格

(defun c:tt (/ ss ss1 ss2 pts i)
(if (setq ss (ssget '((0 . "line"))))
(progn
(setq ss1 (xdrx_entity_copy ss)
ss2 (xdrx_curve_intersectbreak ss1)
pts (xdrx_geom_searchregions ss2)
pts (cdr (vl-sort pts
'(lambda (x1 x2)
(> (apply 'xdrx_points_area x1)
(apply 'xdrx_points_area x2)
)
)
)
)
)
(xdrx_entity_delete ss2)
(setq pts (mapcar '(lambda (x / box bp)
(setq box (apply 'xdrx_points_box x)
bp (car box)
vp (cons
'(0. 0. 0.)
(mapcar '(lambda (a) (mapcar '- a bp))
(cdr box)
)
)
)
(list vp x)
)
pts
)
pts (XD::List:GroupByIndex pts 1e-3)
i 0
)
(mapcar '(lambda (x / j)
(setq i (1+ i)
j 0
)
(mapcar '(lambda (a)
(setq j (1+ j))
(xdrx_text_make
(apply 'xdrx_points_centroid a)
(strcat (itoa i) "-" (itoa j))
(getvar "textsize")
0.
)
)
x
)
)
(mapcar 'cdr pts)
)
)
)
(princ)
)

(defun c:tt (/ ss ss1 ss2 pts i) 
  (if (setq ss (ssget '((0 . "line")))) 
    (progn 
      (setq ss1        (xdrx_entity_copy ss) 
            ss2        (xdrx_curve_intersectbreak ss1) 
            pts        (xdrx_geom_searchregions ss2) 
            pts        (cdr (vl-sort pts 
                              '(lambda (x1 x2) 
                                 (> (apply 'xdrx_points_area x1) 
                                    (apply 'xdrx_points_area x2) 
                                 ) 
                               ) 
                     ) 
                ) 
      ) 
      (xdrx_entity_delete ss2) 
      (setq pts        (mapcar        '(lambda (x / box bp) 
                           (setq box (apply 'xdrx_points_box x) 
                                 bp  (car box) 
                                 vp  (cons 
                                       '(0. 0. 0.) 
                                       (mapcar '(lambda (a) (mapcar '- a bp)) 
                                               (cdr box) 
                                       ) 
                                     ) 
                           ) 
                           (list vp x) 
                         ) 
                        pts 
                ) 
            pts        (XD::List:GroupByIndex pts 1e-3) 
            i        0 
      ) 
      (mapcar '(lambda (x / j) 
                 (setq i (1+ i) 
                       j 0 
                 ) 
                 (mapcar '(lambda (a) 
                            (setq j (1+ j)) 
                            (xdrx_text_make 
                              (apply 'xdrx_points_centroid a) 
                              (strcat (itoa i) "-" (itoa j)) 
                              (getvar "textsize") 
                              0. 
                            ) 
                          ) 
                         x 
                 ) 
               ) 
              (mapcar 'cdr pts) 
      ) 
    ) 
  ) 
  (princ) 
)

q3_2006 · 发表于 2014-3-27 17:13:05

最大的1-1还在...是不是要删除...

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

[教学] API应用 一个区域编号应用

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

[教学] API应用一个区域编号应用