跪求一LISP程序

hl2006

把程序简化一下会不会快一点啊，刚开始那个填充比较快。填充颜色只需品红色就行

hl2006

我们通常是图形放在一个层，线放在另外一个层了。在点线的时候，只要是一个层的就行。

jslxt

淡定淡定淡定

shalei021647

gufeng是高手

CAD83

让你搞怕，某敢出来了

gufeng

相对于87楼的程序还需要修改什么？

move_com

gufeng 发表于 2010-7-15 11:39
1、文件 Function.fas 可于 http://e.ys168.com/?ls0201 上下载，主要是些通用函数打包 部分来源于明经与网 ...

大哥也给我修改下这个代码吧，我找了很久都是对单行文字递增的，我想对多行文字也可以递增。因为有两行文字都要分别递增的。(defun c:dz (/ oce1 n1 zn h1 sxh1 p1)
  (vl-load-com)
  (setq oce1 (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq        ms (vla-get-modelspace
             (vla-get-activedocument (vlax-get-acad-object))
           )
  )
  (if qz
    ()
    (setq qz "")
    )
  (if hz
    ()
    (setq hz "")
    )
  (initget "c")
  (setq nqz (getstring (strcat "\n请输入前缀<" qz ">/c(为空): " )))
(cond
  ((= nqz "c") (setq qz ""))
  (T (if (/= nqz "")(setq qz nqz)))
)
  (setq nhz (getstring (strcat "\n请输入后缀<" hz ">/c(为空): " )))
  (cond
  ((= nhz "c") (setq hz ""))
  (T (if (/= nhz "")(setq hz nhz)))
)
  (if (not (setq n1 (getint "\n请输入起始顺序号 <1>: ")))
    (setq n1 1)
  )
  (if (not (setq zn (getint "\n请输入增加或减少的序数 <+1>: ")))
    (setq zn 1)
  )
  (if (not (setq h1 (getreal "\n请指定文字高度 <2.5>: ")))
    (setq h1 2.5)
  )
  (setq sxh1 (strcat qz (itoa n1) hz))
  (setq p1 (getpoint "\n请指定插入点: "))
  (while (/= p1 nil)
    (setq p1 (vlax-3d-point p1))
    (setq txt  (vla-addtext
                 ms
                 sxh1
                 p1
                 h1
               )
    )
   
    (setq
      n1   (+ n1 zn)
      sxh1 (strcat qz (itoa n1) hz)
      p1   (getpoint "\n请指定下一插入点: ")
    )
      
  )
  (setvar "cmdecho" oce1)
  (vlax-release-object ms)
  (princ)
)
谢谢了。那位大哥help me help me

move_com

gufeng 发表于 2010-7-15 11:39
1、文件 Function.fas 可于 http://e.ys168.com/?ls0201 上下载，主要是些通用函数打包 部分来源于明经与网 ...

大哥给我个代码吧！我在网上找了很久都是关于单行文字的递增复制。现在想找个多行文字也能实现递增的。因为两行上都有要递增的数。下面是单行的代码，我真的找好久了。这是我看到希望了 help me help me
(defun c:dz (/ oce1 n1 zn h1 sxh1 p1)
  (vl-load-com)
  (setq oce1 (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq        ms (vla-get-modelspace
             (vla-get-activedocument (vlax-get-acad-object))
           )
  )
  (if qz
    ()
    (setq qz "")
    )
  (if hz
    ()
    (setq hz "")
    )
  (initget "c")
  (setq nqz (getstring (strcat "\n请输入前缀<" qz ">/c(为空): " )))
(cond
  ((= nqz "c") (setq qz ""))
  (T (if (/= nqz "")(setq qz nqz)))
)
  (setq nhz (getstring (strcat "\n请输入后缀<" hz ">/c(为空): " )))
  (cond
  ((= nhz "c") (setq hz ""))
  (T (if (/= nhz "")(setq hz nhz)))
)
  (if (not (setq n1 (getint "\n请输入起始顺序号 <1>: ")))
    (setq n1 1)
  )
  (if (not (setq zn (getint "\n请输入增加或减少的序数 <+1>: ")))
    (setq zn 1)
  )
  (if (not (setq h1 (getreal "\n请指定文字高度 <2.5>: ")))
    (setq h1 2.5)
  )
  (setq sxh1 (strcat qz (itoa n1) hz))
  (setq p1 (getpoint "\n请指定插入点: "))
  (while (/= p1 nil)
    (setq p1 (vlax-3d-point p1))
    (setq txt  (vla-addtext
                 ms
                 sxh1
                 p1
                 h1
               )
    )
   
    (setq
      n1   (+ n1 zn)
      sxh1 (strcat qz (itoa n1) hz)
      p1   (getpoint "\n请指定下一插入点: ")
    )
      
  )
  (setvar "cmdecho" oce1)
  (vlax-release-object ms)
  (princ)
)

gufeng

move_com 发表于 2011-11-17 12:32
大哥给我个代码吧！我在网上找了很久都是关于单行文字的递增复制。现在想找个多行文字也能实现递增的。因 ...

2. (defun c:dz (/ oce1 n1 zn h1 sxh1 p1 key)
   
3.   (vl-load-com)
   
4.   (setq oce1 (getvar "cmdecho"))
   
5.   (setvar "cmdecho" 0)
   
6.   (setq        ms (vla-get-modelspace
   
7.              (vla-get-activedocument (vlax-get-acad-object))
   
8.            )
   
9.   )
   
10.   (if qz
    
11.     ()
    
12.     (setq qz "")
    
13.   )
    
14.   (if hz
    
15.     ()
    
16.     (setq hz "")
    
17.   )
    
18.   (initget "c")
    
19.   (setq nqz (getstring (strcat "\n请输入前缀<" qz ">/c(为空): ")))
    
20.   (cond
    
21.     ((= nqz "c") (setq qz ""))
    
22.     (T
    
23.      (if (/= nqz "")
    
24.        (setq qz nqz)
    
25.      )
    
26.     )
    
27.   )
    
28.   (setq nhz (getstring (strcat "\n请输入后缀<" hz ">/c(为空): ")))
    
29.   (cond
    
30.     ((= nhz "c") (setq hz ""))
    
31.     (T
    
32.      (if (/= nhz "")
    
33.        (setq hz nhz)
    
34.      )
    
35.     )
    
36.   )
    
37.   (if (not (setq n1 (getint "\n请输入起始顺序号 <1>: ")))
    
38.     (setq n1 1)
    
39.   )
    
40.   (if (not (setq zn (getint "\n请输入增加或减少的序数 <+1>: ")))
    
41.     (setq zn 1)
    
42.   )
    
43.   (if (not (setq h1 (getreal "\n请指定文字高度 <2.5>: ")))
    
44.     (setq h1 2.5)
    
45.   )
    
46.   (initget "1 2")
    
47.   (setq key (getkword "\n单行文字(1)/多行文字(2)<单行>"))
    
48.   (setq sxh1 (strcat qz (itoa n1) hz))
    
49.   (setq p1 (getpoint "\n请指定插入点: "))
    
50.   (while (/= p1 nil)
    
51.     (setq p1 (vlax-3d-point p1))
    
52.     (if        (= key "2")
    
53.       ;;_使用双行文字 对齐点左上角
    
54.       (setq txt        (vla-addmtext
    
55.                   ms
    
56.                   p1
    
57.                   h1
    
58.                   sxh1
    
59.                 )
    
60.       )
    
61.       ;;_使用单行文字 对齐点左下角
    
62.       (setq txt        (vla-addtext
    
63.                   ms
    
64.                   sxh1
    
65.                   p1
    
66.                   h1
    
67.                 )
    
68.       )
    
69.     )
    
70.     (setq
    
71.       n1   (+ n1 zn)
    
72.       sxh1 (strcat qz (itoa n1) hz)
    
73.       p1   (getpoint "\n请指定下一插入点: ")
    
74.     )
    
75.   )
    
76.   (setvar "cmdecho" oce1)
    
77.   (vlax-release-object ms)
    
78.   (princ)
    
79. )

(defun c:dz (/ oce1 n1 zn h1 sxh1 p1 key)<br />   (vl-load-com)<br />   (setq oce1 (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (setq        ms (vla-get-modelspace<br />              (vla-get-activedocument (vlax-get-acad-object))<br />            )<br />   )<br />   (if qz<br />     ()<br />     (setq qz "")<br />   )<br />   (if hz<br />     ()<br />     (setq hz "")<br />   )<br />   (initget "c")<br />   (setq nqz (getstring (strcat "\n请输入前缀<" qz ">/c(为空): ")))<br />   (cond<br />     ((= nqz "c") (setq qz ""))<br />     (T<br />      (if (/= nqz "")<br />        (setq qz nqz)<br />      )<br />     )<br />   )<br />   (setq nhz (getstring (strcat "\n请输入后缀<" hz ">/c(为空): ")))<br />   (cond<br />     ((= nhz "c") (setq hz ""))<br />     (T<br />      (if (/= nhz "")<br />        (setq hz nhz)<br />      )<br />     )<br />   )<br />   (if (not (setq n1 (getint "\n请输入起始顺序号 <1>: ")))<br />     (setq n1 1)<br />   )<br />   (if (not (setq zn (getint "\n请输入增加或减少的序数 <+1>: ")))<br />     (setq zn 1)<br />   )<br />   (if (not (setq h1 (getreal "\n请指定文字高度 <2.5>: ")))<br />     (setq h1 2.5)<br />   )<br />   (initget "1 2")<br />   (setq key (getkword "\n单行文字(1)/多行文字(2)<单行>"))<br />   (setq sxh1 (strcat qz (itoa n1) hz))<br />   (setq p1 (getpoint "\n请指定插入点: "))<br />   (while (/= p1 nil)<br />     (setq p1 (vlax-3d-point p1))<br />     (if        (= key "2")<br />       ;;_使用双行文字 对齐点左上角<br />       (setq txt        (vla-addmtext<br />                   ms<br />                   p1<br />                   h1<br />                   sxh1<br />                 )<br />       )<br />       ;;_使用单行文字 对齐点左下角<br />       (setq txt        (vla-addtext<br />                   ms<br />                   sxh1<br />                   p1<br />                   h1<br />                 )<br />       )<br />     )<br />     (setq<br />       n1   (+ n1 zn)<br />       sxh1 (strcat qz (itoa n1) hz)<br />       p1   (getpoint "\n请指定下一插入点: ")<br />     )<br />   )<br />   (setvar "cmdecho" oce1)<br />   (vlax-release-object ms)<br />   (princ)<br /> )

move_com

gufeng 发表于 2011-11-17 14:51

你好利害呀，写出来了，但是好像用不了，是不是没有改前面的代码，前面的代码是单行信息，后面的多行代码就用不了啦。在CAD中单行和多行上有很大的区别（感觉），用CADi加载后“dz”运行的.再帮下我吧好吗