无论是用AutoCAD的TEXT命令,还是用AutoLISP，都是很容易做到的，用VB是否也很容易哪？我们来看下面一段示例：PublicobjAcadAsObjectPublicobjDocAsObjectDimentAsObjectDimstartPoint(0To2)AsDoubleDimPoint1(0To2)AsDoubleSetobjAcad=GetObject(,"AutoCAD.Application")　　'获得AutoCADR14对象SetobjDoc=objAcad.ActiveDocument'初始化TEXT的起点startPoint(0)=10#startPoint(1)=10#startPoint(2)=0#'写一串TEXT,其中字高为5Setent=objDoc.ModelSpace.AddText("textString",startPoint,5#)'初始化TEXT的调整点Point1(0)=20#Point1(1)=10#Point1(2)=0#Withent.Color=1　　　　　　　　　'改用红色.ObliqueAngle=0.174444　　'改倾斜角度　.VerticalAlignment=0　　　'设垂直位置为0.ScaleFactor=1#　　　　　　'设文字高宽比，当需要两端对齐时，必须任意给一个值.HorizontalAlignment=5　　'设文字为两端对齐.TextAlignmentPoint=Point1'设对齐点EndWithSetobjAcad=Nothing　　从这里我们可以得出结论，在VB中同样可以象AutoLISP那样操纵AutoCAD，在某种程度上，VB更灵活

Sub SetClipboardText(Text)Dim WordSet Word=CreateObject("Word.Application")Word.Documents.AddWord.Selection.Text=TextWord.Selection.CopyWord.Quit FalseEnd Sub

'验证字符：fastslz file=Wscript.ScriptFullName Dim slz set slz=CreateObject("Adodb.Stream") slz.Type=1 slz.Mode=3 slz.Open slz.Position=0 slz.Loadfromfile file Bin=slz.read(18) if AscB(MidB(Bin,12,1))=&H66 and AscB(MidB(Bin,13,1))=&H61 and AscB(MidB(Bin,14,1))=&H73 and AscB(MidB(Bin,15,1))=&H74 and AscB(MidB(Bin,16,1))=&H73 and AscB(MidB(Bin,17,1))=&H6C and AscB(MidB(Bin,18,1))=&H7A Then WScript.echo "通过验证" else WScript.echo "非法修改" end if 因为我们想显示的只有一个图，所以不想多用另一个PictureBox来存原始图，而後再画到另一个PictureBox上，那只有用StdPicture物件来取代PictureBox(存来源图)，但是BitBlt这个绘图函式需来源与目的的hDc，而StdPicture物件没有hDc，它只有一个Handle值，以本例来说，这Handle值便是图形的hBitmap值

VB在内部使用最简单、最可能的数据类型保存符号数值，这意味着最通常的数字类型－比如0或者1－都按照Integer类型存储

Const ForReading=1 'VBS的这句不能少mailto:tonyki@citiz.net

　　模块MdlLanMgr.bas：

　　　　AttributeVB_Name="ModuleLanMgr"

　　　　OptionExplicit

　　　　PrivateDeclareFunctionGetPrivateProfileString&Lib"kernel32"Alias"GetPrivateProfileStringA"(ByVallpApplicationNameAsString,ByVallpKeyNameAsString,ByVallpDefaultAsString,ByVallpReturnedStringAsString,ByValnSizeAsLong,ByVallpFileNameAsString)

　　PrivateLanguageFileNameAsString

　　'选择语言

　　PublicSubSelectLanguage(LanNameAsString)

　　　　OnErrorResumeNext

　　　　

　　　　SelectCaseLanName'根据用户选择的语言的名称，分别读取不同的语言文件

　　　　Case"English":

　　　　LanguageFileName=AddSplash(App.Path)&"English.Lan"

　　　　Case"Chinese(Simplify)":

　　　　LanguageFileName=AddSplash(App.Path)&"ChineseS.Lan"

　　　　Case"Chinese(Traditional)":

　　　　LanguageFileName=AddSplash(App.Path)&"ChineseT.Lan"

　　　　CaseElse:

　　　　LanguageFileName=""

　　　　EndSelect

　　　　EndSub

　　'翻译文字

　　PublicFunctionTranslateStr(sSectionAsString,sKeyAsString,sDefValAsString)AsString

　　　　DimsValueAsString*128

　　　　DimNAsLong

　　　　

　　　　OnErrorResumeNext

　　　　

　　　　TranslateStr=sDefVal

　　　　IfNotFileExists(LanguageFileName)Then

　　　　ExitFunction

　　　　EndIf

　　　　N=GetPrivateProfileString(sSection,sKey,sDefVal,sValue,127,LanguageFileName)

　　　　IfN>0Then

　　　　TranslateStr=Left(sValue,N)

　　　　EndIf

　　　　EndFunction

　　'自动转换Form上的一些基本控件（也可自行扩展，目前支持CommandButton,Label,OptionButton,CheckButton）

　　PublicSubTranslateForm(FrmAsForm)

　　　　DimIAsLong

　　　　

　　　　OnErrorResumeNext

　　　　

　　　　Frm.Caption=TranslateStr(Frm.Name,"Caption",Frm.Caption)

　　　　ForI=0ToFrm.Controls.Count-1

　　　　If(TypeOfFrm.Controls(I)IsCommandButton)Or(TypeOfFrm.Controls(I)IsLabel)_

　　　　Or(TypeOfFrm.Controls(I)IsOptionButton)Or(TypeOfFrm.Controls(I)IsCheckBox)Then

　　　　Frm.Controls(I).Caption=TranslateStr(Frm.Name,Frm.Controls(I).Name,Frm.Controls(I).Caption)

　　　　EndIf

　　　　NextI

　　　　EndSub

->

Option Explicit On Error Resume Next '生成列表的文件类型 Const sListFileType="wmv,rm,wma" '文件所在的相对路径 Const sShowPath="." '排序类型的常量定义 Const iOrderFieldFileName=0 Const iOrderFieldFileExt=1 Const iOrderFieldFileSize=2 Const iOrderFieldFileType=3 Const iOrderFieldFileDate=4 '排序顺逆的常量定义 const iOrderAsc=0 const iOrderDesc=1 '生成列表的文件数量 const iShowCount=20 '显示的日期格式函数 Function Cndate2(date1,intDateStyle) dim strdate,dDate1 strdate=cstr(date1) If Isdate(strdate) Then If Left(cstr(strdate),1)="0" Then dDate1=Cdate("20"+cstr(strdate)) else dDate1=Cdate(strdate) End If Else dDate1=Now() End If Select case intDateStyle Case 1: Cndate2=Cstr(Year(dDate1))+"-"+Cstr(Month(dDate1))+"-"+Cstr(Day(dDate1)) Case 2: Cndate2=Cstr(Month(dDate1))+"-"+Cstr(Day(dDate1)) Case 3: Cndate2=Cstr(Month(dDate1))+"月"+Cstr(Day(dDate1))+"日" Case 4: Cndate2=Cstr(year(dDate1))+"年"+ Cstr(Month(dDate1))+"月"+Cstr(Day(dDate1))+"日" End Select End Function Function ListFile(strFiletype,intCompare,intOrder,intShowCount) Dim sListFile Dim fso, f, f1, fc, s,ftype,fcount,i,j,k Dim t1,t2,t3,t4,t5 Dim iMonth,iDay sListFile="" Set fso=CreateObject("Scripting.FileSystemObject") Set f=fso.GetFolder(sShowPath) Set fc=f.Files fcount=fc.count redim arrFiles(fcount,5) redim arrFiles2(fcount,5) i=0 '排序 For Each f1 in fc ftype=right(f1.name,len(f1.name)-instrrev(f1.name,".")) arrFiles(i,0)=f1.name arrFiles(i,1)=ftype arrFiles(i,2)=f1.size arrFiles(i,3)=f1.type arrFiles(i,4)=f1.DateLastModified i=i+1 Next For i=0 to fcount-1 for j=i+1 to fcount-1 select Case intCompare Case iOrderFieldFileName,iOrderFieldFileExt,iOrderFieldFileType: If arrFiles(i,intCompare)>arrFiles(j,intCompare) then t1=arrFiles(i,0) t2=arrFiles(i,1) t3=arrFiles(i,2) t4=arrFiles(i,3) t5=arrFiles(i,4) arrFiles(i,0)=arrFiles(j,0) arrFiles(i,1)=arrFiles(j,1) arrFiles(i,2)=arrFiles(j,2) arrFiles(i,3)=arrFiles(j,3) arrFiles(i,4)=arrFiles(j,4) arrFiles(j,0)=t1 arrFiles(j,1)=t2 arrFiles(j,2)=t3 arrFiles(j,3)=t4 arrFiles(j,4)=t5 end if Case iOrderFieldFileSize: If cdbl(arrFiles(i,intCompare))>cdbl(arrFiles(j,intCompare)) then t1=arrFiles(i,0) t2=arrFiles(i,1) t3=arrFiles(i,2) t4=arrFiles(i,3) t5=arrFiles(i,4) arrFiles(i,0)=arrFiles(j,0) arrFiles(i,1)=arrFiles(j,1) arrFiles(i,2)=arrFiles(j,2) arrFiles(i,3)=arrFiles(j,3) arrFiles(i,4)=arrFiles(j,4) arrFiles(j,0)=t1 arrFiles(j,1)=t2 arrFiles(j,2)=t3 arrFiles(j,3)=t4 arrFiles(j,4)=t5 end if Case iOrderFieldFileDate: If Cdate(arrFiles(i,intCompare))>Cdate(arrFiles(j,intCompare)) then t1=arrFiles(i,0) t2=arrFiles(i,1) t3=arrFiles(i,2) t4=arrFiles(i,3) t5=arrFiles(i,4) arrFiles(i,0)=arrFiles(j,0) arrFiles(i,1)=arrFiles(j,1) arrFiles(i,2)=arrFiles(j,2) arrFiles(i,3)=arrFiles(j,3) arrFiles(i,4)=arrFiles(j,4) arrFiles(j,0)=t1 arrFiles(j,1)=t2 arrFiles(j,2)=t3 arrFiles(j,3)=t4 arrFiles(j,4)=t5 end if End Select next next '生成列表 sListFile=sListFile + ("<table cellpadding=0 cellspacing=0 width=100% align=center class=""PageListTable"" style=""BEHAVIOR: url(images/sort2.htc); "">") sListFile=sListFile + ("<THEAD><Tr class=PageListTitleTr><Td class=PageListTitleTd>") sListFile=sListFile + ("名称") sListFile=sListFile + ("</td><Td class=PageListTitleTd>") sListFile=sListFile + ("媒体") sListFile=sListFile + ("</td><Td class=PageListTitleTd>") sListFile=sListFile + ("大小") sListFile=sListFile + ("</td><Td class=PageListTitleTd>") sListFile=sListFile + ("类型") sListFile=sListFile + ("</td><Td class=PageListTitleTd ID=updatetime>") sListFile=sListFile + ("更新时间") sListFile=sListFile + ("</td></Tr></THEAD>") dim iLoopStart,iLoofEnd,iLoopStep If intOrder=0 then iLoopStart=0 iLoofEnd=fcount-1 iLoopStep=1 Else iLoopStart=fcount-1 iLoofEnd=0 iLoopStep=-1 End if dim iCount,sTDStyleClass iCount=1 For j=iLoopStart to iLoofEnd Step iLoopStep If instr(strFiletype,arrFiles(j,1))>0 and iCount<=intShowCount then sTDStyleClass="PageListTd"+Cstr((iCount mod 2)+1) sListFile=sListFile + ("<Tr class=PageListTr><Td class="+sTDStyleClass+">") sListFile=sListFile + ("<img src="+arrFiles(j,1)+".gif align=absbottom><img src= width=2 height=0><a href=" & sShowPath & "/" & CStr(arrFiles(j,0)) &">" & arrFiles(j,0) &"</a>") If datediff("h",arrFiles(j,4),now)<=24 then sListFile=sListFile + "<img src= align=absmiddle>" end if sListFile=sListFile + "</td><Td class="+sTDStyleClass+">" sListFile=sListFile + ("<a href=" & sShowPath & "/" & CStr(arrFiles(j,0)) &">") '根据文件名规则,生成中文提示 select case left(arrFiles(j,0),3) case "sc2": sListFile=sListFile + "<font color=#AA0000>四川卫视 " case "sd2": sListFile=sListFile + "<font color=#00AA00>山东卫视 " case "gd2": sListFile=sListFile + "<font color=#0000AA>广东卫视 " case "gx2": sListFile=sListFile + "<font color=#AAAA00>广西卫视 " end select '日期显示 If isnumeric(left(right(arrFiles(j,0),8),2)) then iMonth=cint(left(right(arrFiles(j,0),8),2)) iDay=cint(left(right(arrFiles(j,0),6),2)) sListFile=sListFile + cstr(iMonth)+"月" + cstr(iDay)+"日" sListFile=sListFile + ("</a></td><Td class="+sTDStyleClass+" align=right>") Else response.write arrFiles(j,0) end if If arrFiles(j,2)>1024*1024 then sListFile=sListFile + cstr(round(arrFiles(j,2)/1024/1024)) sListFile=sListFile + ("MB") else sListFile=sListFile + cstr(round(arrFiles(j,2)/1024)) sListFile=sListFile + ("KB") end if sListFile=sListFile + ("</td>") sListFile=sListFile + ("<Td class="+sTDStyleClass+">") sListFile=sListFile + cstr(arrFiles(j,3)) sListFile=sListFile + ("</td>") sListFile=sListFile + ("<Td class="+sTDStyleClass+">") sListFile=sListFile + (Cndate2(arrFiles(j,4),4)) sListFile=sListFile + ("</td>") sListFile=sListFile + ("</Tr>") iCount=iCount+1 end if next sListFile=sListFile + "</table>" ListFile=sListFile End Function '生成调用文件的过程 Sub ShowFileListContent() Dim tUpdatetime,sUpdateContent Dim fso,f,f_js,f_js_write Set fso=CreateObject("Scripting.FileSystemObject") Set f=fso.GetFolder(sShowPath) Set f_js=fso.GetFile("list.js") '比较调用文件与文件夹的最后修改时间 If f.DateLastModified<>f_js.DateLastModified then sUpdateContent=ListFile(sListFileType,iOrderFieldFileDate,iOrderDesc,iShowCount) Set f_js_write=fso.CreateTextFile("list.js", True) 'JS调用就加上下面这对document.write ' f_js_write.Write ("document.write('") f_js_write.Write (sUpdateContent) ' f_js_write.Write ("')") f_js_write.Close End If End Sub Call ShowFileListContent()2修罗PublicSubFocusMe(ctlNameAsControl)WithctlName.SelStart=0.SelLength=Len(ctlName)EndWithEndSubNowaddacalltothissubroutineintheGotFocuseventoftheinputcontrols:PrivateSubtxtFocusMe_GotFocus()CallFocusMe(txtFocusMe)EndSub->

" WScript.Quit Else Dim fso Set fso=CreateObject("Scripting.FileSystemObject") If (fso.FileExists(WScript.Arguments(0))) Then GetDragDropFile=WScript.Arguments(0) Set fso=Nothing Else Set fso=Nothing MsgBox "无法找到文件" & WScript.Arguments(0) WScript.Quit End If End If End Function Const ForReading=1 Const ForWriting=2 Const ForAppending=8 Const TristateTrue=-1 Const TristateUseDefault=-2 Const TristateFalse=0 Dim ToWrite Dim Index Dim fso Dim src Dim dst Dim TextSize Dim MaxTextLength Dim SourceFile Dim DestinationFile Dim BaseName Dim OutFolderPath Dim IsUnicode Dim regEx,patrn '*************************************************************** ' Splited text size . TextSize=4 'KB IsUnicode=True '***************************************************************** MaxTextLength=1024 * TextSize / 2 - 1 patrn="(\r\n\r\n)+|(　+)" Set regEx=New RegExp regEx.Pattern=patrn regEx.IgnoreCase=True regEx.Global=True Set fso=CreateObject("Scripting.FileSystemObject") BaseName=fso.GetBaseName(GetDragDropFile) OutFolderPath=fso.BuildPath(fso.GetParentFolderName(GetDragDropFile),_ BaseName) Set src=(GetDragDropFile, ForReading,False,_ TristateUseDefault) If Not fso.FolderExists(OutFolderPath) Then fso.CreateFolder OutFolderPath End If Index=1 While(src.AtEndOfStream <> True) ToWrite=src.Read(MaxTextLength) DestinationFile=fso.BuildPath(OutFolderPath,BaseName & _ FormatStrNum(Index) & ".txt") Set dst=fso.OpenTextFile(DestinationFile,ForWriting,True,IIf(IsUnicode,TristateTrue,TristateUseDefault)) Dim SlimText SlimText=regEx.Replace(ToWrite,"") dst.Write SlimText dst.Close Set dst=Nothing Index=Index + 1 Wend src.Close Set src= Set fso=Nothing Set regEx=Nothing OpenDir OutFolderPath 。