[LISP程序]：求圆中心线绘制程序！

zwx123

请高手编写一个圆或圆弧中心线绘制程序，点击圆弧即画出过圆心十字中心线。

lsjjm

请参考下面程序, 可画圆,圆弧及椭圆的中心线.

2. 
   
3. (defun c:test ()
   
4.   (setq ent (entsel "\Nselect Ent(Arc,Circle,Ellipse): "))
   
5.   (setq entd (entget (car ent)))
   
6.   (setq pc (cdr (assoc 10 entd)))
   
7.   (setq d 0.1)
   
8.   (cond
   
9.     ((= (cdr (assoc 0 entd)) "ARC")
   
10.       (setq rad (cdr (assoc 40 entd))
    
11.                p1 (polar pc (cdr (assoc 50 entd))(+ rad d))
    
12.              p2 (polar pc (angle p1 pc)(+ rad d))))     
    
13.     ((= (cdr (assoc 0 entd)) "CIRCLE")
    
14.       (setq rad (cdr (assoc 40 entd))
    
15.               p1 (polar pc 0 (+ rad d))
    
16.              p2 (polar pc pi (+ rad d))))     
    
17.     ((= (cdr (assoc 0 entd)) "ELLIPSE")
    
18.       (setq px (cdr (assoc 11 entd))
    
19.             px (list (+ (car pc)(car px))(+ (cadr pc)(cadr px)) 0)
    
20.            rad (distance pc px))
    
21.     (setq p1 (polar pc (angle pc px)(+ rad d))
    
22.             p2 (polar pc (angle px pc)(+ rad d))
    
23.           rad1 (* (cdr (assoc 40 entd)) rad)
    
24.             ri (/ (+ rad1 d)(+ rad d))))
    
25.   );c
    
26.   (if p2 (vl-cmdf "line" p1 p2 ""))
    
27.   (setq lline (entlast))
    
28.   (vl-cmdf "copy" (entlast) "" pc pc "" "rotate" (entlast) "" pc 90 "")
    
29.   (if (= (cdr (assoc 0 entd)) "ELLIPSE")(vl-cmdf "scale" lline "" pc ri ""))
    
30. )

<br /> (defun c:test ()<br />   (setq ent (entsel "\Nselect Ent(Arc,Circle,Ellipse): "))<br />   (setq entd (entget (car ent)))<br />   (setq pc (cdr (assoc 10 entd)))<br />   (setq d 0.1)<br />   (cond<br />     ((= (cdr (assoc 0 entd)) "ARC")<br />       (setq rad (cdr (assoc 40 entd))<br />                p1 (polar pc (cdr (assoc 50 entd))(+ rad d))<br />              p2 (polar pc (angle p1 pc)(+ rad d))))     <br />     ((= (cdr (assoc 0 entd)) "CIRCLE")<br />       (setq rad (cdr (assoc 40 entd))<br />               p1 (polar pc 0 (+ rad d))<br />              p2 (polar pc pi (+ rad d))))     <br />     ((= (cdr (assoc 0 entd)) "ELLIPSE")<br />       (setq px (cdr (assoc 11 entd))<br />             px (list (+ (car pc)(car px))(+ (cadr pc)(cadr px)) 0)<br />            rad (distance pc px))<br />     (setq p1 (polar pc (angle pc px)(+ rad d))<br />             p2 (polar pc (angle px pc)(+ rad d))<br />           rad1 (* (cdr (assoc 40 entd)) rad)<br />             ri (/ (+ rad1 d)(+ rad d))))<br />   );c<br />   (if p2 (vl-cmdf "line" p1 p2 ""))<br />   (setq lline (entlast))<br />   (vl-cmdf "copy" (entlast) "" pc pc "" "rotate" (entlast) "" pc 90 "")<br />   (if (= (cdr (assoc 0 entd)) "ELLIPSE")(vl-cmdf "scale" lline "" pc ri ""))<br /> )

陌生人

标注里面有 标注圆心
dimcenter

lsjjm

最初由 陌生人 发布
[B]标注里面有 标注圆心
dimcenter [/B]

原问问的是中心线, 不是圆心!

liuyj

晓东工具里就有，在命令行输入cline，试试吧

陌生人

最初由 lsjjm 发布
[B]

原问问的是中心线, 不是圆心! [/B]

"圆或圆弧中心线绘制程序，点击圆弧即画出过圆心十字中心线。"
呵呵.还是请楼主确认一下了. cad那个是在圆心标注十字中心线啊?!

看看测试效果
好像test标注圆弧有点问题啊.那个十字交点怎么看也和中心线搭不上边.呵呵

coolzhb

最初由 lsjjm 发布
[B]请参考下面程序, 可画圆,圆弧及椭圆的中心线.
[code]
(defun c:test ()
  (setq ent (entsel "\Nselect Ent(Arc,Circle,Ellipse): "))
  (setq entd (entget (car ent)))
  (setq pc (cdr (assoc 10 entd)))
... [/B]

不知道长老能不能编一个画矩形中心线的程序，这个我认为更常用！

lsjjm

7楼:这是以前编的一个画矩形中心线的程序, 可能有些繁琐, 但能用, 试试看:
(defun c:test ()
  (setq a (car (entsel)))
  (setq pts (massoc 10 (entget a)))
  (setq pc (inters (car pts)(nth 2 pts)(cadr pts)(last pts)))
  (setq w (distance (car pts)(cadr pts))
        h (distance (car pts)(last pts)))
  (vl-cmdf "line" (polar pc 0 (+ (/ w 2) 0.1))(polar pc pi (+ (/ w 2) 0.1)) "")
  (vl-cmdf "line" (polar pc (/ pi 2)(+ (/ h 2) 0.1))(polar pc (* 1.5 pi)(+ (/ h 2) 0.1)) "")
)
(defun massoc (key alist / nlist)
  (foreach x alist
    (if (eq key (car x))
      (setq nlist (cons (cdr x) nlist))
    )
  )
  (reverse nlist)
)

陌生人

(setq pts (massoc 10 (entget a)))
多了个m
这样你以前能用么?

lsjjm

最初由 陌生人 发布
[B](setq pts (massoc 10 (entget a)))
多了个m这样你以前能用么? [/B]

希望你把程序看完! massoc是个子程序 !?

zhiyongfan

多发这些帖子,我正在学习,谢谢

coolzhb

挺好用的，但矩形在平面图内有角度时，中心线就不对了，还得完善一下！

guanzhangyang

你的中心线需要超出圆周多少？
  我帮你做了，就这点不能确定，是用VBA做的。
如果有需要请与我联系：gzy@mjtd.com

zhangzongwei

晓东工具中连接线段是用lisp编的吗，这段可以个源程序吗？

lsjjm

最初由 coolzhb 发布
[B]挺好用的，但矩形在平面图内有角度时，中心线就不对了，还得完善一下！ [/B]

将
(vl-cmdf "line" (polar pc 0 (+ (/ w 2) 0.1))(polar pc pi (+ (/ w 2) 0.1)) "")
(vl-cmdf "line" (polar pc (/ pi 2)(+ (/ h 2) 0.1))(polar pc (* 1.5 pi)(+ (/ h 2) 0.1)) "")
改为
  (setq ang (angle (car pts)(cadr pts)))
  (vl-cmdf "line" (polar pc ang (+ (/ w 2) 0.1))
                         (polar pc (- ang pi)(+ (/ w 2) 0.1)) "")
  (vl-cmdf "line" (polar pc (+ ang (/ pi 2))(+ (/ h 2) 0.1))
                         (polar pc (- ang (/ pi 2))(+ (/ h 2) 0.1)) "") 即可.
原程序简化后:
(defun c:test ( / pts)
  (setq a (car (entsel)))
  (foreach i (entget a)(if (= 10 (car i))(setq pts (append pts (list (cdr i))))))
  (setq pc (inters (car pts)(caddr pts)(cadr pts)(last pts)))
  (setq w (distance (car pts)(cadr pts))
           h (distance (car pts)(last pts))
       ang (angle (car pts)(cadr pts)))
  (vl-cmdf "line" (polar pc ang (+ (/ w 2) 0.1))
                         (polar pc (- ang pi)(+ (/ w 2) 0.1)) "")
  (vl-cmdf "line" (polar pc (+ ang (/ pi 2))(+ (/ h 2) 0.1))
                         (polar pc (- ang (/ pi 2))(+ (/ h 2) 0.1)) "")
)