[求助]插入文字的特殊要求

pckite

版主sorry!~不能怪wmz，怪我吧

pckite

谢谢wmz! 你的程序好像不能运行？我看不出来是什么原理实现的，请你解释一下好吗？

wmz

pckite朋友:你可采取以下步骤去做:
1,将Txt.lsp文件拷入"c:\windows\system"文件夹中;将Text.dvb拷入用户文件夹;
2,加载工程:
加载方法一:选工具->宏->加载工程,点Text.dvb文件就行了;
加载方法二:在ACAD.DVB文件的ACADStartup过程里写一条AcadApplication.LoadDVB "X:\..\Text.dvb";
加载方法三:在命令行里打入如下命令:-vbaload,然后根据提示进行操作,或者做一按纽,在特性栏写上
^C^C-vbaload "X:/../Text.DVB"
(注意方法二里的斜杠是顺着的,方法三里的斜杠是反着的不是这里打字错了!)
3,在菜单或者工具栏里写如下命令:_-vbarun txtmk.tgc
4,点命令按纽运行.
其实现方法是:
在FORM1窗体模块的初始化过程里用以下命令对"Txt.lsp"进行装载:
CXM = "C:/windows/system/Txt.lsp"
ThisDrawing.SendCommand "(" & "LOAD" & Chr(34) & CXM & Chr(34) & ")" & vbCr
在按纽Cmd1的Click事件里用
ThisDrawing.SendCommand "_Txtdm" & vbCr
命令调用LISP程序的Txtdm函数,文字可随着鼠标,点在那里就写在那里,效果应该还是不错的.
以上够麻烦的了!你自己可以简化.
这是我以前根据工作需要写的一个小程序,编程技巧很差.我嫌VBA字体设置太麻烦,又嫌LISP对话框不好使,于是,我采取二者所长,用VBA做对话框,用LISP写文字,用一临时文件在二者之间传递参数和数据(临时文件会自动生成,用户不用担心).搞成了现在这个样子,我也懒得再去优化它了.当然也没有这个水平.如果你有兴趣,希你把它优化以下.

pckite

TO　wmz： 　　谢谢你的帮助！谢谢你给我这么详细的支持！￣
　　我先理解后试着优化，然后再帖出来吧~

yingxunxue

有问题.点"确定"后老是在CAD命令行中出现命令: _Txtdm
LAYER
当前图层: 0
输入选项
[?/生成(M)/设置(S)/新建(N)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/打印(P)/冻结(
F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)]: s
输入要置为当前的图层名或 <选择对象>: ZJ
找不到图层“ZJ”。
; 错误: 函数被取消

wmz

对不起!我说了,这是我在以前编写的,当时的前提是已经定义了"ZJ" 层,不要紧,好在
我提供了源码,下面一句(程序的第一句):
(COMMAND "LAYER" "s" "ZJ" "")
是在已有"ZJ"层的情况下写的,打包时忽略了,还有就是findfile函数的使用上也是假
定在ACAD环境设定为可搜索路径的情况......实在抱歉!现将源码略加修改后附上. ;写地区名
(defun C:Txtdm(/ ff f0 f1 f2 zx zt zdx ztdx wzmc blxs n dqm0 dqm kdbl qxj zdx0 i n0 p0)
(command "_LAYER" "m" "ZJ" "")
(setq ff "" qxj "" kdbl "")
(setq qxj0 0.0 kdbl0 0.0 blc0 0.0)
(setq f1 "c:\\windows\\system\\Textlib.dat")
(setq f2 (open f1 "r"))
(setq zt (read-line f2)
zdx (read-line f2)
wzmc (read-line f2)
fsxz (read-line f2)
qxj (read-line f2)
kdbl (read-line f2)
blc (read-line f2))
(close f2)
(setq blc0 (atof blc))
(setq blxs (/ blc0 1000.0))
(setq ff "c:\\windows\\system\\wzmcwj.cfg")
(setq f0 (open ff "r"))
(setq n 0 dqm0 "")
(while (setq dqm (read-line f0))
(setq dqm0 (strcat dqm0 dqm)
n (+ n 1))
)
(close f0)
(cond ((= zdx "1")(setq zdx0 (* blxs 6.0)))
((= zdx "2")(setq zdx0 (* blxs 5.0)))
((= zdx "3")(setq zdx0 (* blxs 3.5)))
((= zdx "4")(setq zdx0 (* blxs 2.5)))
((= zdx "5")(setq zdx0 (* blxs 1.5)))
)
(setq zx (cond ((= zt "黑体") "ht")
((= zt "宋体") "st")
((= zt "楷体") "kt")
((= zt "仿宋") "fs")
((= zt "中等线") "zd")
((= zt "细等线") "xd"))
)
(setq zt (cond ((= zx "ht") "黑体")
((= zx "st") "宋体")
((= zx "kt") "楷体_GB2312")
((= zx "fs") "仿宋_GB2312")
((= zx "zd") "方正中等线简体")
((= zx "xd") "方正细等线简体"))
)
(setq kdbl0 (atof kdbl))(setq qxj0 (atof qxj))
(command "style" zx zt "" kdbl0 qxj0 "N" "N")
(setq i 1 n0 -1 ztdx (rtos zdx0 2 1))
(if (= fsxz "f")(progn
(while (<= i n)
(setq n0 (+ n0 2))
(setq dqm (substr dqm0 n0 2))
(setq p0 (getpoint "\n插入点:"))
(command "text" "m" p0 ztdx "0" dqm)
(setq i (+ i 1))
)
)
)
(if (= fsxz "z")(progn
(setq p0 (getpoint "\n插入点:"))
(command "text" "m" p0 ztdx "0" dqm0)
)
)
)

pckite

看到来了,总之很不错的.