看看圆中心线标注程式问题出在那里？

李义东

; center.lsp
;本程序创建多个孔的中心线。

(defun C:CENTER (/ COUNT_1 COUNT_2 DIST OBJECTS_X OBJECTS_Y SCALE
      CENTER CENTER_2 ENTITY_1 ENTITY_2 RADIUS RADIUS_2
      LEFT LEFT_2 RIGHT RIGHT_2 NAME
   BOTTOM BOTTOM_2 TOP TOP_2)
   ;设置所有变量
   (setvar "CMDECHO" 0)
   (command "linetype" "S" "CENTER" "")
   (setq SCALE (getvar "DIMSCALE"))
   (setq DIST (* 0.1 SCALE))
   ; 拾取所有的圆
   (princ "\n选择所有希望添加中心线的圆:")
   (princ "\n ")
   (setq OBJECTS_X (ssget '((0 . "CIRCLE"))))
   ;构造两个选择集（水平和垂直）
   (setq OBJECTS_Y (ssget ""))
   ; 绘制水平线的主循环
   (setq COUNT_1 0)
   (while (< COUNT_1 (sslength OBJECTS_X))
      (setq ENTITY_1 (entget (ssname OBJECTS_X COUNT_1)))
      (setq CENTER (cdr (assoc 10 ENTITY_1)))
      (setq RADIUS (cdr (assoc 40 ENTITY_1)))
      (setq RIGHT (polar center 0.0 (+ RADIUS DIST)))
      (setq LEFT (polar RIGHT 3.141592654 (* 2.0 (+ RADIUS DIST))))
      (setq COUNT_2 (+ COUNT_1 1))
      (while (< COUNT_2 (sslength OBJECTS_X))
         (setq ENTITY_2 (entget (ssname OBJECTS_X COUNT_2)))
         (setq CENTER_2 (cdr (assoc 10 ENTITY_2)))
         (if (< (ABS (-  (cadr CENTER) (cadr CENTER_2))) 0.0001)
            (progn
               (setq RADIUS_2 (cdr (assoc 40 ENTITY_2)))
               (setq RIGHT_2 (polar CENTER_2 0.0 (+ RADIUS_2 DIST)))
               (setq LEFT_2 (polar RIGHT_2 3.141592654 (* 2.0 (+ RADIUS_2 DIST))))
               (if (< (car LEFT_2) (car LEFT))
                  (setq LEFT LEFT_2)
               )
               (if (> (car RIGHT_2) (car RIGHT))
                  (setq RIGHT RIGHT_2)
               )
               (setq NAME (ssname OBJECTS_X COUNT_2))
               (setq OBJECTS_X (ssdel NAME OBJECTS_X))
               (setq COUNT_2 (- COUNT_2 1))
            )
         )
         (setq COUNT_2 (+ COUNT_2 1))
      )      (command "line" LEFT RIGHT "")
      (setq COUNT_1 (+ COUNT_1 1))
   )      
   ; 绘制垂直线的主循环
   (setq COUNT_1 0)
   (while (< COUNT_1 (sslength OBJECTS_Y))
      (setq ENTITY_1 (entget (ssname OBJECTS_Y COUNT_1)))
      (setq CENTER (cdr (assoc 10 ENTITY_1)))
      (setq RADIUS (cdr (assoc 40 ENTITY_1)))
      (setq TOP (polar CENTER 1.570796327 (+ RADIUS DIST)))
      (setq BOTTOM (polar TOP 4.712388981 (* 2.0 (+ RADIUS DIST))))
      (setq COUNT_2 (+ COUNT_1 1))
      (while (< COUNT_2 (sslength OBJECTS_Y))
         (setq ENTITY_2 (entget (ssname OBJECTS_Y COUNT_2)))
         (setq CENTER_2 (cdr (assoc 10 ENTITY_2)))
         (if (< (ABS (-  (car CENTER) (car CENTER_2))) 0.0001)
            (progn
               (setq RADIUS_2 (cdr (assoc 40 ENTITY_2)))
               (setq TOP_2 (polar CENTER_2 1.570796327 (+ RADIUS_2 DIST)))
               (setq BOTTOM_2 (polar TOP_2 4.712388981 (* 2.0 (+ RADIUS_2 DIST))))
               (if (> (cadr TOP_2) (cadr TOP))
                  (setq TOP TOP_2)
               )
               (if (< (cadr BOTTOM_2) (cadr BOTTOM))
                  (setq BOTTOM BOTTOM_2)
               )
               (setq NAME (ssname OBJECTS_Y COUNT_2))
               (setq OBJECTS_Y (ssdel NAME OBJECTS_Y))
               (setq COUNT_2 (- COUNT_2 1))
            )
         )
         (setq COUNT_2 (+ COUNT_2 1))
      )
      (command "line" TOP BOTTOM "")
      (setq COUNT_1 (+ COUNT_1 1))
   )
   ; 复位所有变量并清除绘图
   (command "linetype" "S" "BYLAYER" "")
   (command "redraw")
   (setvar "cmdecho" 1)
); end center.lsp

meflying

哪儿有问题呢？

李义东

画不出中心线,只能出现一个中心点

meflying

可在我这里调试正确啊，看结果是否你需要的。。。

李义东

OK!OK!   是我的电脑有问题!感谢大侠!
再请教一个问题-------以上程式如何让同X及同Y坐标的圆中心线不相连,每个圆的中心线是独立的且伸出量为1/3圆

meflying

难道是这样：（未做处理，不应该啊，这个比你的那个简单多了）

2. 
   
3. (defun c:center( / ss i j ent ents ptc r pts)
   
4.   (setq ss (ssget '((0 . "CIRCLE"))))
   
5.   (setq i 0)
   
6.   (repeat (sslength ss)
   
7.     (setq ent (ssname ss i))
   
8.     (setq ents (entget ent))
   
9.     (setq ptc (cdr (assoc 10 ents))
   
10.           r (cdr (assoc 40 ents))
    
11.           j 0
    
12.           pts'())
    
13.     (repeat 4
    
14.       (setq pts (append pts (list (polar ptc (* j (/ pi 2)) (+ r (/ r 3))))))
    
15.       (setq j (1+ j))
    
16.     )
    
17.     (command "_.line" (nth 0 pts) (nth 2 pts) ""
    
18.              "_.line" (nth 1 pts) (nth 3 pts) "")
    
19.     (setq i (1+ i))
    
20.   )
    
21.   (princ)
    
22. )

<br /> (defun c:center( / ss i j ent ents ptc r pts)<br />   (setq ss (ssget '((0 . "CIRCLE"))))<br />   (setq i 0)<br />   (repeat (sslength ss)<br />     (setq ent (ssname ss i))<br />     (setq ents (entget ent))<br />     (setq ptc (cdr (assoc 10 ents))<br />           r (cdr (assoc 40 ents))<br />           j 0<br />           pts'())<br />     (repeat 4<br />       (setq pts (append pts (list (polar ptc (* j (/ pi 2)) (+ r (/ r 3))))))<br />       (setq j (1+ j))<br />     )<br />     (command "_.line" (nth 0 pts) (nth 2 pts) ""<br />              "_.line" (nth 1 pts) (nth 3 pts) "")<br />     (setq i (1+ i))<br />   )<br />   (princ)<br /> )

李义东

感谢!真是高手让我开眼界啦!