API应用不同角度块排行列并按紧邻分组

st788796 · 发表于 2014-2-17 14:32:16

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

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

×

本帖最后由 st788796 于 2014-2-17 17:40 编辑

(defun c:tt (/ _makecircle _prossrow _drawcircle ss lst mat0 wid rad)
(defun _makecircle (p / e)
(setq e (xdrx_circle_make p rad))
(xdrx_entity_setcolor e 3)
)
;;
(defun _pnts:divbydis (p1 p2 dis / n ptl an)
(setq n (fix (/ (distance p1 p2) dis))
ptl (list p1)
an (angle p1 p2)
)
(repeat n
(setq ptl (cons (polar (car ptl) an dis) ptl))
)
(reverse ptl)
)
;;行内按临近分组
(defun _prossrow (lst / ll)
(setq lst (mapcar '(lambda (x)
(list (xdrx_getpropertyvalue x "Position") x)
)
lst
)
ll (list (list (car lst)))
lst (cdr lst)
)
(while lst
(if (equal (distance (caar lst) (caaar ll)) wid 1e-2)
(setq ll (cons (cons (car lst) (car ll)) (cdr ll)))
(setq ll (cons (list (car lst)) ll))
)
(setq lst (cdr lst))
)
ll
)
;;一个紧邻组车位绘制定位点
(defun _drawcircle (lst / len p1 p2 ptl)
(setq len (length lst))
(cond
((= len 1) ;_一个车位
(_makecircle (caar lst))
)
((= len 2) ;_两个车位
(_makecircle
(xdrx_line_midp (caar lst) (caadr lst))
)
)
((zerop (rem len 2)) ;_偶数车位
(while lst
(_makecircle
(xdrx_line_midp (caar lst) (caadr lst))
)
(setq lst (cddr lst))
)
)
(t
(setq p1 (caar lst)
p2 (car (last lst))
ptl (_pnts:divbydis p1 p2 2.5)
)
(mapcar '(lambda (x)
(_makecircle x)
)
ptl
)
) ;_奇数车位
)
)
(setq wid 2.5) ;_ 车位宽度
(setq rad 0.2) ;_圆圈直径
(if (setq ss (ssget '((0 . "insert"))))
(progn
(setq lst (mapcar '(lambda (x)
(list (xdrx_getpropertyvalue x "Rotation")
(list (xdrx_getpropertyvalue x "Position")
x
)
) ;_((角度 (插入点块)) ....)
)
(xdrx_pickset->ents ss)
)
lst (XD::List:GroupByIndex lst 1e-3) ;_按角度分组((an1 (p11 e11) ...) (an2 (p22 e22) ...)...)
mat0 (xdrx_matrix_identity 3)
lst (mapcar
'(lambda (x / mat)
(setq mat (xdrx_matrix_setrotation
mat0
(- (car x)) ;_转正排序
'(0 0 1)
'(0 0 0)
)
) ;_建立不同角度的坐标系
(mapcar
'(lambda (a)
(list (xdrx_point_transform (car a) mat) (cadr a))
)
(cdr x)
) ;_转换插入点
)
lst
)
lst (mapcar '(lambda (x)
(XD::List:TableSort x 0 0 1e-3) ;_每个角度的分行
)
lst
) ;_对不同角度的分别排行 (((row11) (row12) ...) ((row21) (row22) ...) ...)
lst (mapcar '(lambda (x)
(mapcar '(lambda (a)
(mapcar 'cadr a)
)
x ;_每个角度
)
)
lst
)
lst (mapcar '(lambda (x)
(mapcar '(lambda (a)
(_prossrow a)
)
(vl-remove nil x)
) ;_每个行内再分组
)
lst ;_(((e11 e12 ...) (e21 e22 ...)) ...)
)
)
(mapcar '(lambda (x)
(mapcar '(lambda (a)
(mapcar '(lambda (b)
(_drawcircle b) ;_一个组团
)
a ;_行组
)
)
x ;_角度组
)
)
lst
)
)
)
(princ)
)

(defun c:tt (/ _makecircle _prossrow _drawcircle ss lst mat0 wid rad) 
  (defun _makecircle (p / e) 
    (setq e (xdrx_circle_make p rad)) 
    (xdrx_entity_setcolor e 3) 
  ) 
  ;; 
  (defun _pnts:divbydis        (p1 p2 dis / n ptl an) 
    (setq n   (fix (/ (distance p1 p2) dis)) 
          ptl (list p1) 
          an  (angle p1 p2) 
    ) 
    (repeat n 
      (setq ptl (cons (polar (car ptl) an dis) ptl)) 
    ) 
    (reverse ptl) 
  ) 
  ;;行内按临近分组 
  (defun _prossrow (lst / ll) 
    (setq lst (mapcar '(lambda (x) 
                         (list (xdrx_getpropertyvalue x "Position") x) 
                       ) 
                      lst 
              ) 
          ll  (list (list (car lst))) 
          lst (cdr lst) 
    ) 
    (while lst 
      (if (equal (distance (caar lst) (caaar ll)) wid 1e-2) 
        (setq ll (cons (cons (car lst) (car ll)) (cdr ll))) 
        (setq ll (cons (list (car lst)) ll)) 
      ) 
      (setq lst (cdr lst)) 
    ) 
    ll 
  ) 
  ;;一个紧邻组车位绘制定位点 
  (defun _drawcircle (lst / len p1 p2 ptl) 
    (setq len (length lst)) 
    (cond 
      ((= len 1) ;_一个车位 
       (_makecircle (caar lst)) 
      ) 
      ((= len 2) ;_两个车位 
       (_makecircle 
         (xdrx_line_midp (caar lst) (caadr lst)) 
       ) 
      ) 
      ((zerop (rem len 2)) ;_偶数车位 
       (while lst 
         (_makecircle 
           (xdrx_line_midp (caar lst) (caadr lst)) 
         ) 
         (setq lst (cddr lst)) 
       ) 
      ) 
      (t 
       (setq p1         (caar lst) 
             p2         (car (last lst)) 
             ptl (_pnts:divbydis p1 p2 2.5) 
       ) 
       (mapcar '(lambda        (x) 
                  (_makecircle x) 
                ) 
               ptl 
       ) 
      ) ;_奇数车位 
    ) 
  ) 
  (setq wid 2.5) ;_ 车位宽度 
  (setq rad 0.2) ;_圆圈直径 
  (if (setq ss (ssget '((0 . "insert")))) 
    (progn 
      (setq lst         (mapcar '(lambda (x) 
                            (list (xdrx_getpropertyvalue x "Rotation") 
                                  (list        (xdrx_getpropertyvalue x "Position") 
                                        x 
                                  ) 
                            ) ;_((角度 (插入点 块)) ....) 
                          ) 
                         (xdrx_pickset->ents ss) 
                 ) 
            lst         (XD::List:GroupByIndex lst 1e-3) ;_按角度分组((an1 (p11 e11) ...) (an2 (p22 e22) ...)...) 
            mat0 (xdrx_matrix_identity 3) 
            lst         (mapcar 
                   '(lambda (x / mat) 
                      (setq mat        (xdrx_matrix_setrotation 
                                  mat0 
                                  (- (car x)) ;_转正排序 
                                  '(0 0 1) 
                                  '(0 0 0) 
                                ) 
                      ) ;_建立不同角度的坐标系 
                      (mapcar 
                        '(lambda (a) 
                           (list (xdrx_point_transform (car a) mat) (cadr a)) 
                         ) 
                        (cdr x) 
                      ) ;_转换插入点 
                    ) 
                   lst 
                 ) 
            lst         (mapcar '(lambda (x) 
                            (XD::List:TableSort x 0 0 1e-3) ;_每个角度的分行 
                          ) 
                         lst 
                 ) ;_对不同角度的分别排行 (((row11) (row12) ...) ((row21) (row22) ...) ...) 
            lst         (mapcar '(lambda (x) 
                            (mapcar '(lambda (a) 
                                       (mapcar 'cadr a) 
                                     ) 
                                    x ;_每个角度 
                            ) 
                          ) 
                         lst 
                 ) 
            lst         (mapcar '(lambda (x) 
                            (mapcar '(lambda (a) 
                                       (_prossrow a) 
                                     ) 
                                    (vl-remove nil x) 
                            ) ;_每个行内再分组 
                          ) 
                         lst ;_(((e11 e12 ...) (e21 e22 ...)) ...) 
                 ) 
      ) 
      (mapcar '(lambda (x) 
                 (mapcar '(lambda (a) 
                            (mapcar '(lambda (b) 
                                       (_drawcircle b) ;_一个组团 
                                     ) 
                                    a ;_行组 
                            ) 
                          ) 
                         x ;_角度组 
                 ) 
               ) 
              lst 
      ) 
    ) 
  ) 
  (princ) 
)

434939575 · 发表于 2014-2-17 16:55:45

抢个沙发。mapcar如此强大。{:soso_e113:}。好好学习。

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

[教学] API应用 不同角度块排行列并按紧邻分组

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

[教学] API应用不同角度块排行列并按紧邻分组