同心圆处理

千秋雪

坛子里找了段同心圆的代码，楞是不会用，逻辑关系太复杂，想求大家帮忙改改。主要是同心坐标去重复，另外求出大圆半径。框选一堆圆，含单圆和同心圆，依次在他们圆心上用文字标出它的直径。如遇同心圆就只标大圆直径。谢谢大家。

(defun c:tt (/ CNT DATA EN HDL HHH IDX II RRR SS)
  (if (setq ii -1
     ss (ssget '((0 . "CIRCLE")))
      )
    (repeat (sslength ss)
      (setq en (ssname ss (setq ii (1+ ii)))
     hdl (cdr (assoc 5 (entget en)))
     cnt (cdr (assoc 10 (entget en)))
     rrr (cdr (assoc 40 (entget en)))
     idx (strcat (rtos (car cnt) 2 3) "#" (rtos (cadr cnt) 2 3))
      )
      (if (null (setq hhh (cdr (assoc idx data))))
(setq data (cons (cons idx hdl) data))
(if (> (cdr (assoc 40 (entget (handent hhh))))
        rrr
     )
   (setq hhh  (entdel (handent hhh))
  data (subst (cons idx hdl) (assoc idx data) data)
   )
   ;(entdel en)
          (command "text" "m" "non" cnt  (* rrr 0.8) 0 (* rrr 2))
)
      )
    )
  )
)

千秋雪

琴剑江山_10184 发表于 2017-12-3 14:19

你好，谢谢你的代码，那种输出形式不太会用。

我从别人的代码中另摘录了一段，可否再次麻烦你帮忙改改
(defun c:tt ()
  (setq ss (ssget '((0 . "ARC,CIRCLE"))))
  (setq sscir (ssadd))
  ((> (sslength sscir) 0)  ;圆、圆弧，处理同心圆
    (setq lst nil)
    (foreach en (ss-enlst sscir) ;((图元 圆心)……)
      (setq cen_po (vlax-get (vlax-ename->vla-object en) 'center))
      (setq lst (cons (list en cen_po) lst))
    )
    (while (> (length lst) 0)  ;直到抽空表为止
      (setq lst2 (vl-remove-if-not
     '(lambda (x) (equal (cadar lst) (cadr x) 1e-8))
     lst
   )
      )     ;查找所有与第一个同心
      (princ "aaaaaaaaaaaa") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;这里开始没值
      (foreach en lst2 (setq lst (vl-remove en lst))) ;从总表移除
      (setq lst2 (mapcar '(lambda (x) (car x)) lst2)) ;得到同心圆表
      (if (> (length lst2) 1)  ;2个以上进行半径从大至小排序
(setq lst2
        (vl-sort lst2
   (function
     (lambda (a b)
       (> (vla-get-radius (vlax-ename->vla-object a))
          (vla-get-radius (vlax-ename->vla-object b))
       )
     )
   )
        )
)
      )
      (setq en (car lst2))
      (setq cen_po (vlax-get (vlax-ename->vla-object en) 'center)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;希望输出形式像这样
      (setq rr (vla-get-radius (vlax-ename->vla-object en)));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;希望输出形式像这样
      (command "text" "m" "non" cnt  (* rr 0.8) 0 (* rr 2))
    )
  )
)
(defun ss-enlst (ss / enlst)   ;选择集与对象名表互转
  (cond
    ((= (type ss) 'PICKSET)
     (vl-remove-if-not
       '(lambda (x) (= (type x) 'ENAME))
       (mapcar 'cadr (ssnamex SS))
     )
    )
    ((= (type ss) 'LIST)
     (setq enlst (ssadd))
     (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
    )
  )
)

琴剑江山_10184

1. (defun c:Tt (/ DD LEN N1 NS P1 PT SS SSC)
   
2.   (setq ssC (ssget '((0 . "CIRCLE"))))
   
3.   (setq Len (sslength ssC) ns '())
   
4.   (repeat Len
   
5.     (setq n1 (ssname ssC (setq Len (1- Len)))
   
6.           pt (cdr (assoc 10 (entget n1)))
   
7.           dd (list (cdr (assoc 40 (entget n1)))))
   
8.     (if (setq ss (assoc pt ns))
   
9.       (setq ns (subst (list pt (append dd (cadr ss))) ss ns))
   
10.       (setq ns (cons (list pt dd) ns))            
    
11.       )
    
12.   )
    
13.   (foreach K ns
    
14.     (setq p1 (length (cadr k)))
    
15.     (if (> p1 1)
    
16.       (entmake (list '(0 . "TEXT") (cons 10 (car k)) (cons 1 (rtos (* (apply 'max (cadr k))2) 2 2)) (cons 40 5)))
    
17.       (entmake (list '(0 . "TEXT") (cons 10 (car k)) (cons 1 (rtos (* (caadr k)2) 2 2)) (cons 40 5)))
    
18.       )
    
19.     )
    
20.   (princ)
    
21. )
    

(defun c:Tt (/ DD LEN N1 NS P1 PT SS SSC)<br />   (setq ssC (ssget '((0 . "CIRCLE"))))<br />   (setq Len (sslength ssC) ns '())<br />   (repeat Len<br />     (setq n1 (ssname ssC (setq Len (1- Len)))<br />           pt (cdr (assoc 10 (entget n1)))<br />           dd (list (cdr (assoc 40 (entget n1)))))<br />     (if (setq ss (assoc pt ns))<br />       (setq ns (subst (list pt (append dd (cadr ss))) ss ns))<br />       (setq ns (cons (list pt dd) ns))            <br />       )<br />   )<br />   (foreach K ns<br />     (setq p1 (length (cadr k)))<br />     (if (> p1 1)<br />       (entmake (list '(0 . "TEXT") (cons 10 (car k)) (cons 1 (rtos (* (apply 'max (cadr k))2) 2 2)) (cons 40 5)))<br />       (entmake (list '(0 . "TEXT") (cons 10 (car k)) (cons 1 (rtos (* (caadr k)2) 2 2)) (cons 40 5)))<br />       )<br />     )<br />   (princ)<br /> )<br />

llsheng_73

1. (defun c:tt(/ s i a l x e)
   
2.   (if(setq s(ssget'((0 . "circle"))))
   
3.     (foreach x(repeat(setq i(sslength s))
   
4.                 (setq i(1- i)
   
5.     e(ssname s i)
   
6.     x(entget e)
   
7.     x(list(cdr(assoc 10 x))(cdr(assoc 40 x)))
   
8.     a(assoc(car x)l))
   
9.   (if(member(cadr x)a)(setq e(entdel e)l l)
   
10.     (setq l(if a(subst(append a(cdr x))a l)(cons x l)))))
    
11.       (entmakex(mapcar'cons'(0 10 40 1)(list"text"(car x)200(rtos(*(apply'max(cdr x))2)))))))
    
12.   )

(defun c:tt(/ s i a l x e)<br />   (if(setq s(ssget'((0 . "circle"))))<br />     (foreach x(repeat(setq i(sslength s))<br />                 (setq i(1- i)<br />     e(ssname s i)<br />     x(entget e)<br />     x(list(cdr(assoc 10 x))(cdr(assoc 40 x)))<br />     a(assoc(car x)l))<br />   (if(member(cadr x)a)(setq e(entdel e)l l)<br />     (setq l(if a(subst(append a(cdr x))a l)(cons x l)))))<br />       (entmakex(mapcar'cons'(0 10 40 1)(list"text"(car x)200(rtos(*(apply'max(cdr x))2)))))))<br />   )

xyp1964

题目不错：圆消重＋同心圆最大半径标注

千秋雪

llsheng_73 发表于 2017-12-3 12:04

你好，谢谢你的代码，现在把圆和半径合并到x里面去，更难搞了，可以简单点么

xyp1964

琴剑江山_10184 发表于 2017-12-3 14:19

没达到需要的效果。
可以试试下面这个图。

xyp1964

千秋雪

楼上代码是从“小笨智能中心线v1.3”抄的，在此谢过原作者。

琴剑江山_10184

xyp1964 发表于 2017-12-4 00:51

同心圆去重，同心最大圆标R。