[LISP程序]：改进的画中心线程序, 批量处理...

lsjjm

改进的画中心线程序. 不但可以批量对圆, 且对任意位置的圆弧和椭圆画中心线, 请大家试用提出意见.

2. 
   
3. (defun c:test ()
   
4.   (setvar "osmode" 0)
   
5.   (setq olayer (getvar "clayer"))
   
6.   (mlayer "cline" "yellow" "center2")
   
7.   (setq ss (ssget))
   
8.   (if (< (length (ssnamex ss 0)) 2)
   
9.     (setq pq (cadr (last (car (ssnamex ss 0)))))
   
10.     (setq pq (cadr (nth 2 (cadr (ssnamex ss 0)))))
    
11.   );i
    
12.   (setq ns (sslength ss) n 0)
    
13.   (while (< n ns)
    
14.     (setq ent (ssname ss n))
    
15.     (setq pc (dxf 10 ent))
    
16.     (cond
    
17.       ((= (dxf 0 ent) "ARC")
    
18.         (setq rad (dxf 40 ent)
    
19.                d (/ (fix (* rad 100)) 1000.0)
    
20.               p1 (polar pc (dxf 50 ent)(+ rad d))
    
21.               p2 (polar pc (angle p1 pc)(+ rad d))))     
    
22.       ((= (dxf 0 ent) "CIRCLE")
    
23.         (setq rad (dxf 40 ent)
    
24.                d (/ (fix (* rad 100)) 1000.0)
    
25.               p1 (polar pc 0 (+ rad d))
    
26.               p2 (polar pc pi (+ rad d))))     
    
27.       ((= (dxf 0 ent) "ELLIPSE")
    
28.         (setq px (dxf 11 ent)
    
29.               px (list (+ (car pc)(car px))(+ (cadr pc)(cadr px)) 0)
    
30.              rad (distance pc px)
    
31.                d (/ (fix (* rad 10)) 100.0)
    
32.               p1 (polar pc (angle pc px)(+ rad d))
    
33.               p2 (polar pc (angle px pc)(+ rad d))
    
34.             rad1 (* (dxf 40 ent) rad)
    
35.               ri (/ (+ rad1 d)(+ rad d))))
    
36.     );c
    
37.     (if p2 (vl-cmdf "line" p1 p2 ""))
    
38.     (setq lline (entlast))
    
39.     (vl-cmdf "copy" (entlast) "" pc pc "" "rotate" (entlast) "" pc 90 "")
    
40.     (if (= (dxf 0 ent) "ELLIPSE")(vl-cmdf "scale" lline "" pc ri ""))
    
41.     (setq n (1+ n))
    
42.   );w
    
43.   (setvar "clayer" olayer)
    
44.   (setvar "osmode" 37)
    
45.   (princ)
    
46. );defun

<br /> (defun c:test ()<br />   (setvar "osmode" 0)<br />   (setq olayer (getvar "clayer"))<br />   (mlayer "cline" "yellow" "center2")<br />   (setq ss (ssget))<br />   (if (< (length (ssnamex ss 0)) 2)<br />     (setq pq (cadr (last (car (ssnamex ss 0)))))<br />     (setq pq (cadr (nth 2 (cadr (ssnamex ss 0)))))<br />   );i<br />   (setq ns (sslength ss) n 0)<br />   (while (< n ns)<br />     (setq ent (ssname ss n))<br />     (setq pc (dxf 10 ent))<br />     (cond<br />       ((= (dxf 0 ent) "ARC")<br />         (setq rad (dxf 40 ent)<br />                d (/ (fix (* rad 100)) 1000.0)<br />               p1 (polar pc (dxf 50 ent)(+ rad d))<br />               p2 (polar pc (angle p1 pc)(+ rad d))))     <br />       ((= (dxf 0 ent) "CIRCLE")<br />         (setq rad (dxf 40 ent)<br />                d (/ (fix (* rad 100)) 1000.0)<br />               p1 (polar pc 0 (+ rad d))<br />               p2 (polar pc pi (+ rad d))))     <br />       ((= (dxf 0 ent) "ELLIPSE")<br />         (setq px (dxf 11 ent)<br />               px (list (+ (car pc)(car px))(+ (cadr pc)(cadr px)) 0)<br />              rad (distance pc px)<br />                d (/ (fix (* rad 10)) 100.0)<br />               p1 (polar pc (angle pc px)(+ rad d))<br />               p2 (polar pc (angle px pc)(+ rad d))<br />             rad1 (* (dxf 40 ent) 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 (= (dxf 0 ent) "ELLIPSE")(vl-cmdf "scale" lline "" pc ri ""))<br />     (setq n (1+ n))<br />   );w<br />   (setvar "clayer" olayer)<br />   (setvar "osmode" 37)<br />   (princ)<br /> );defun

lsjjm

补充:
(defun mlayer (name color ltype)
  (if (tblsearch "layer" name)
      (vl-cmdf "layer" "s" name "")
      (progn
        (setq regen (getvar "regenmode"))
        (setvar "regenmode" 0)
        (vl-cmdf "layer" "m" name)
        (if color (vl-cmdf "c" color name))
        (if ltype (vl-cmdf "lt" ltype name))
        (vl-cmdf "")
        (setvar "regenmode" regen)
      )
  )
)

(defun dxf (code ename)(cdr (assoc code (entget ename))));

ww721

怎么使用/

lsjjm

你不熟悉lisp? 加载,调用按提示选择实体呀?

LUCAS

我想他要告訴你有些函數未附上,如mlayer,dxf,所以不能用

梦断江南

补充完函数后再加币

dingweidong

挺不错！

cxzr8

期待楼主完成，非常实用的程序。

lsjjm

最初由 cxzr8 发布
[B]期待楼主完成，非常实用的程序。 [/B]

已经补充了呀? 请试用提出意见.

xiaping

最初由 lsjjm 发布
[B]

已经补充了呀? 请试用提出意见. [/B]

用了一下觉得很实用。但是也发现不知为什么画一个中心线以后会出现两次出错提示。如下图所示。另外对于选择的实体较多时运行速度太慢。请看一下，为什么会出现错误提示。谢谢了

JOSDENNIS

呵呵. 樓主的寫程序過急了不夠細心所以有點有點美中不足,

這句 (vl-cmdf "copy" (entlast) "" pc pc "" "rotate" (entlast) "" pc 90 "")
多了兩個 ""  這個符號1 . 改里來就好了. 如下
(vl-cmdf "copy" (entlast) "" pc pc  "rotate" (entlast) "" pc 90 )


還有下面這句也是上面的問題.
(if (= (dxf 0 ent) "ELLIPSE")(vl-cmdf "scale" lline "" pc ri ""))
改為
(if (= (dxf 0 ent) "ELLIPSE")(vl-cmdf "scale" lline "" pc ri ))

xiaping

最初由 JOSDENNIS 发布
[B]呵呵. 樓主的寫程序過急了不夠細心所以有點有點美中不足,

這句 (vl-cmdf "copy" (entlast) "" pc pc "" "rotate" (entlast) "" pc 90 "")
多了兩個 ""  這個符號1 . 改里來就好了. 如下
(vl-cmdf "copy" (entl... [/B]

谢谢了，这样一改就OK了。

Michael_66

需要画椭圆中心线程序，试用一下

pppk

我想他要告訴你有些函數未附上,如mlayer,dxf,所以不能用

lsjjm

最初由 pppk 发布
[B]我想他要告訴你有些函數未附上,如mlayer,dxf,所以不能用 [/B]

看上面的贴子. 半年前已经解决了.