<p>把程序简化一下会不会快一点啊，刚开始那个填充比较快。填充颜色只需品红色就行</p>
<p>我们通常是图形放在一个层，线放在另外一个层了。在点线的时候，只要是一个层的就行。</p>
淡定淡定淡定
gufeng是高手
让你搞怕，某敢出来了
相对于87楼的程序还需要修改什么？
gufeng 发表于 2010-7-15 11:39 static/image/common/back.gif
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
gufeng 发表于 2010-7-15 11:39 static/image/common/back.gif
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)
)
move_com 发表于 2011-11-17 12:32 static/image/common/back.gif
大哥给我个代码吧！我在网上找了很久都是关于单行文字的递增复制。现在想找个多行文字也能实现递增的。因 ...
(defun c:dz (/ oce1 n1 zn h1 sxh1 p1 key)
(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)
)
(initget "1 2")
(setq key (getkword "\n单行文字(1)/多行文字(2)<单行>"))
(setq sxh1 (strcat qz (itoa n1) hz))
(setq p1 (getpoint "\n请指定插入点: "))
(while (/= p1 nil)
(setq p1 (vlax-3d-point p1))
(if (= key "2")
;;_使用双行文字 对齐点左上角
(setq txt (vla-addmtext
ms
p1
h1
sxh1
)
)
;;_使用单行文字 对齐点左下角
(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 发表于 2011-11-17 14:51 static/image/common/back.gif
你好利害呀，写出来了，但是好像用不了，是不是没有改前面的代码，前面的代码是单行信息，后面的多行代码就用不了啦。在CAD中单行和多行上有很大的区别（感觉），用CADi加载后“dz”运行的.再帮下我吧好吗