麻烦哪位老师帮忙改改删除椭圆新建圆的代码谢谢

flytoday

(defun C:css (/ ss1 t1 v)
  (setq ss1 (ssget '((0 . "ELLIPSE"))))
  (setq t1 0)
  (setq v (getvar "osmode"))
  (setvar "osmode" 0)
  (while (ssname ss1 t1)
    (command "circle"
      (cdr (assoc 10 (entget (ssname ss1 t1))))
      "D"
      100
    )
    (setq t1 (+ 1 t1))
  )
  (command "erase" ss1 "")
  (setvar "osmode" v)
)

本代码是删除椭圆在圆心处新建直径为100mm的圆...
请问为什么在如下的测试圆中不行..

麻烦哪位老师改改谢谢

LLXXZZ

2. (defun C:css (/ ss1 t1 v temp)
   
3.   (setq ss1 (ssget '((0 . "ELLIPSE"))))
   
4.   (setq t1 0)
   
5.   (setq v (getvar "osmode"))
   
6.   (setvar "osmode" 0)
   
7.   (while (setq temp (ssname ss1 t1))  
   
8.    
   
9.     (command "circle"
   
10.       (trans (cdr (assoc 10 (entget temp))) 0 1)
    
11.       "D"
    
12.       100
    
13.     )
    
14.     (setq t1 (+ 1 t1))
    
15.     (ENTDEL temp)
    
16.   )  
    
17.   (setvar "osmode" v)
    
18. )
    
19. 
    

(defun C:css (/ ss1 t1 v temp)<br />   (setq ss1 (ssget '((0 . "ELLIPSE"))))<br />   (setq t1 0)<br />   (setq v (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (while (setq temp (ssname ss1 t1))  <br />     <br />     (command "circle"<br />       (trans (cdr (assoc 10 (entget temp))) 0 1)<br />       "D"<br />       100<br />     )<br />     (setq t1 (+ 1 t1))<br />     (ENTDEL temp)<br />   )  <br />   (setvar "osmode" v)<br /> )<br /> <br />

大致改了下,测试ok.

yjr111

加一句(command "ucs" "w")试试

xyp1964

2. (defun c:tt (/ ss t1 v)
   
3.   (if (setq ss (ssget '((0 . "ELLIPSE"))))
   
4.     (progn
   
5.       (setq i -1)
   
6.       (while (setq s1 (ssname ss (setq i (1+ i))))
   
7.         (setq pt (cdr (assoc 10 (entget s1))))
   
8.         (command "circle" pt "D" 100)
   
9.       )
   
10.       (command "erase" ss "")
    
11.     )
    
12.   )
    
13.   (princ)
    
14. )
    

(defun c:tt (/ ss t1 v)<br />   (if (setq ss (ssget '((0 . "ELLIPSE"))))<br />     (progn<br />       (setq i -1)<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq pt (cdr (assoc 10 (entget s1))))<br />         (command "circle" pt "D" 100)<br />       )<br />       (command "erase" ss "")<br />     )<br />   )<br />   (princ)<br /> )<br />

flytoday

曾经被院长踢出群。。。院长您大师能不能帮我改下您老滴插件啊。。。
附件如下。。。能不能给如下的插件定一个条件就就双平行线距离在351mm以内只标注一边啊。。谢谢

xyp1964

2. 
   
3. ;; 批量标注线长和编号
   
4. (defun c:test910 ()
   
5.   (CMDLAsc0)
   
6.   (setq        ss  (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")))
   
7.         i   -1
   
8.         lst '()
   
9.   )
   
10.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
11.     (setq lst (cons (list (xyp-get-CurveLength s1) s1) lst))
    
12.   )
    
13.   (setq        lst  (vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2))))
    
14.         i    0
    
15.         lst2 '()
    
16.   )
    
17.   (foreach a lst
    
18.     (setq leng (car a)
    
19.           s1   (cadr a)
    
20.     )
    
21.     (if        (not (member leng lst2))
    
22.       (setq lst2 (cons leng lst2)
    
23.             i         (1+ i)
    
24.       )
    
25.     )
    
26.     (setq pt  (xyp-get-CurveMidPoint s1)
    
27.           rad (XYP-RAD2REAL (XYP-GET-ANGLEATPOINT s1 pt) 1)
    
28.           p1  (polar pt rad 5)
    
29.           p2  (polar pt rad -5)
    
30.           pt  (xyp-get-RightPoint p1 p2 (* xyp-sc 200))
    
31.     )
    
32.     (xyp-Text 5 pt (strcat "L" (itoa i) "=" (rtos leng 2)))
    
33.     (xyp-SubUpd (entlast) 50 rad)
    
34.   )
    
35.   (CMDLA1)
    
36. )
    

<br /> ;; 批量标注线长和编号<br /> (defun c:test910 ()<br />   (CMDLAsc0)<br />   (setq        ss  (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")))<br />         i   -1<br />         lst '()<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq lst (cons (list (xyp-get-CurveLength s1) s1) lst))<br />   )<br />   (setq        lst  (vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2))))<br />         i    0<br />         lst2 '()<br />   )<br />   (foreach a lst<br />     (setq leng (car a)<br />           s1   (cadr a)<br />     )<br />     (if        (not (member leng lst2))<br />       (setq lst2 (cons leng lst2)<br />             i         (1+ i)<br />       )<br />     )<br />     (setq pt  (xyp-get-CurveMidPoint s1)<br />           rad (XYP-RAD2REAL (XYP-GET-ANGLEATPOINT s1 pt) 1)<br />           p1  (polar pt rad 5)<br />           p2  (polar pt rad -5)<br />           pt  (xyp-get-RightPoint p1 p2 (* xyp-sc 200))<br />     )<br />     (xyp-Text 5 pt (strcat "L" (itoa i) "=" (rtos leng 2)))<br />     (xyp-SubUpd (entlast) 50 rad)<br />   )<br />   (CMDLA1)<br /> )<br />

1993063

先坐标还原
(COMMAND "UCS" "W")
测试结果可用

kwok

院长代码.