[求助]插入文字的特殊要求 - VBA/VB/ActiveX/API 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第2页

pckite 发表于 2004-6-15 08:35:00

版主sorry!~不能怪<A name=27132>wmz</A>，怪我吧

pckite 发表于 2004-6-15 11:06:00

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

wmz 发表于 2004-6-15 21:49:00

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 发表于 2004-6-16 08:23:00

TO　<A name=27423>wmz</A>：

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

yingxunxue 发表于 2004-6-18 20:33:00

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

wmz 发表于 2004-6-18 21:17:00

对不起!我说了,这是我在以前编写的,当时的前提是已经定义了"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 发表于 2004-6-20 11:24:00

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

页: 1 [2]

明经CAD社区's Archiver