请高手帮忙；取圆半径排列圆（Y坐标不变.只水平方向移动）

434939575 · 发表于 2014-2-13 21:45:51

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

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

×

本帖最后由 434939575 于 2014-2-13 21:53 编辑

;modfiy by edata @2013-12-25 10:51:17
；现有程序按半径排列
(defun c:tt(/ CEN-10 EN I O_CMD O_OS PT0 PTY RAD-40 SS SS0);局部变量要设置
(princ " \n 按大小点选圆");无排序函数,按选择排序
   (setq o_cmd (getvar "CMDECHO"));保存要更改的变量值
   (setq o_os (getvar "osmode"));保存要更改的变量值
   (setvar "CMDECHO" 0);_关闭命令提示
(Setvar "osmode" 0);_关闭捕捉
      (if (setq ss (ssget '((0 . "circle"))))
      (progn
      (setq  pt0 (getpoint "排列起始点"))
         (setq i 0)
         (repeat (sslength ss)
         (setq ss0 (ssname ss i)
               en (entget ss0)
            cen-10(cdr (assoc 10 en)) ;pt=圆心坐标
            rad-40(cdr (assoc 40 en)) ;pt=圆半径
         i (1+ i)
            ); (setq ss0

            (setq pty(polar cen-10 0 rad-40));获得原来圆的右面点
            (setq pt0(polar pt0 0 (+ rad-40 rad-40)));设置新的右边点
   (command "move" ss0 "" pty pt0 "") ;command
      ); (repeat
   )
      )
   (and o_cmd (setvar "CMDECHO" o_cmd));恢复更改的变量值
   (and o_os (setvar "osmode" o_os));恢复更改的变量值
   )

xyp1964 · 发表于 2014-2-13 22:35:02

;; 需要e派工具箱(XCAD)的支持：[url]http://yunpan.cn/QXQKsW9gAPmpF[/url]
;; 圆Y轴相切排序
(defun c:tt ()
(princ "\n按大小点选圆: ")
(if (setq ss (ssget '((0 . "circle"))))
(progn
(setq lst (vl-sort (xyp-ss2list ss)
'(lambda (x y)(< (cadr (xyp-DXF 10 x)) (cadr (xyp-DXF 10 y))))
)
)
(while (and (setq s1 (car lst))
(setq s2 (cadr lst))
)
(setq lst (cdr lst)
rr (+ (xyp-DXF 40 s1) (xyp-DXF 40 s2))
p2 (xyp-DXF 10 s2)
p1 (xyp-Pt2X (xyp-DXF 10 s1) rr)
p1 (list (car p1) (cadr p2))
s2 (xyp-move s2 p2 p1)
)
)
)
)
(princ)
)

434939575 · 发表于 2014-2-13 23:09:20

感谢院长出手这么快！多谢了！

炫翔 · 发表于 2014-2-14 08:27:10

其他的函数院长好像有公布,
我分享下这个函数(临时的)
(defun xx-pt2x(p num)
(list(+ (car p) num)(cadr p))
)

承接CAD二次开发项目(价格实惠)
QQ:2363673534

炫翔 · 发表于 2014-2-14 08:28:44

(xx-pt2x '(0 0) 5)-->(5 0)
(xx-pt2x '(0 0) -5)-->(-5 0)

st788796 · 发表于 2014-2-14 08:39:53

(defun c:tt (/ ss lst)
(if (setq ss (ssget '((0 . "circle"))))
(progn
(setq lst (mapcar '(lambda (x)
(list (xdrx_getpropertyvalue x "Center")
(xdrx_getpropertyvalue x "Radius")
x
);((pcen1 r1 e1) (pcen2 r2 e2) ....)
)
(xdrx_pickset->ents ss)
)
lst (vl-sort lst
'(lambda (x y)
(if (equal (cadar x) (cadar y) 1e-3)
(< (caar x) (caar y))
(< (cadar x) (cadar y))
)
)
);_ y (x) sort
)
(mapcar '(lambda (e1 e2 / p1 r1)
(setq p1 (xdrx_getpropertyvalue (last e1) "Center")
r1 (cadr e1)
)
(xdrx_setpropertyvalue
(last e2)
"Center"
(list (+ (car p1) r1 (cadr e2))
(cadar e2)
(last (car e2))
)
);_根据前一个圆调整下一个圆位置
)
lst
(cdr lst)
)
)
)
(princ)
)

(defun c:tt (/ ss lst) 
  (if (setq ss (ssget '((0 . "circle")))) 
    (progn 
      (setq lst        (mapcar        '(lambda (x) 
                           (list (xdrx_getpropertyvalue x "Center") 
                                 (xdrx_getpropertyvalue x "Radius") 
                                 x 
                           );((pcen1 r1 e1) (pcen2 r2 e2) ....) 
                         ) 
                        (xdrx_pickset->ents ss) 
                ) 
            lst        (vl-sort lst 
                         '(lambda (x y) 
                            (if        (equal (cadar x) (cadar y) 1e-3) 
                              (< (caar x) (caar y)) 
                              (< (cadar x) (cadar y)) 
                            ) 
                          ) 
                );_ y (x) sort 
      ) 
      (mapcar '(lambda (e1 e2 / p1 r1) 
                 (setq p1 (xdrx_getpropertyvalue (last e1) "Center") 
                       r1 (cadr e1) 
                 ) 
                 (xdrx_setpropertyvalue 
                   (last e2) 
                   "Center" 
                   (list (+ (car p1) r1 (cadr e2)) 
                         (cadar e2) 
                         (last (car e2)) 
                   ) 
                 );_根据前一个圆调整下一个圆位置 
               ) 
              lst 
              (cdr lst) 
      ) 
    ) 
  ) 
  (princ) 
)

st788796 · 发表于 2014-2-14 08:56:01

借用几个函数，和上面的完全一致

(defun c:tt (/ lst)
(fy:clearcset)
(if (ssget '((0 . "circle")))
(progn
(setq lst (mapcar '(lambda (x)
(list (vlax-get x 'Center)
(vlax-get x 'Radius)
x
)
)
(fy:cset->objs)
)
lst (vl-sort lst
'(lambda (x y)
(if (equal (cadar x) (cadar y) 1e-3)
(< (caar x) (caar y))
(< (cadar x) (cadar y))
)
)
)
)
(mapcar '(lambda (e1 e2 / p1 r1)
(setq p1 (vlax-get (last e1) 'Center)
r1 (cadr e1)
)
(vlax-put
(last e2)
'Center
(list
(+ (car p1) r1 (cadr e2))
(cadar e2)
(last (car e2))
)
)
)
lst
(cdr lst)
)
)
)
(princ)
)

(defun c:tt (/ lst) 
  (fy:clearcset) 
  (if (ssget '((0 . "circle"))) 
    (progn 
      (setq lst        (mapcar        '(lambda (x) 
                           (list (vlax-get x 'Center) 
                                 (vlax-get x 'Radius) 
                                 x 
                           ) 
                         ) 
                        (fy:cset->objs) 
                ) 
            lst        (vl-sort lst 
                         '(lambda (x y) 
                            (if        (equal (cadar x) (cadar y) 1e-3) 
                              (< (caar x) (caar y)) 
                              (< (cadar x) (cadar y)) 
                            ) 
                          ) 
                ) 
      ) 
      (mapcar '(lambda (e1 e2 / p1 r1) 
                 (setq p1 (vlax-get (last e1) 'Center) 
                       r1 (cadr e1) 
                 ) 
                 (vlax-put 
                   (last e2) 
                   'Center 
                   (list 
                     (+ (car p1) r1 (cadr e2)) 
                     (cadar e2) 
                     (last (car e2)) 
                   ) 
                 ) 
               ) 
              lst 
              (cdr lst) 
      ) 
    ) 
  ) 
  (princ) 
)

434939575 · 发表于 2014-2-14 11:30:58

十分感谢大家热心的帮助！

清风明月10 · 发表于 2014-2-15 10:35:14

谢谢各位楼主的分享！很有意思的代码，收藏备用。

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

[求助] 请高手帮忙；取圆半径排列圆（Y坐标不变.只水平方向移动）

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

评分

评分