《CAD二次開(kāi)發(fā)源碼》由會(huì)員分享，可在線閱讀，更多相關(guān)《CAD二次開(kāi)發(fā)源碼（5頁(yè)珍藏版）》請(qǐng)?jiān)谘b配圖網(wǎng)上搜索。
1、文檔供參考，可復(fù)制、編制，期待您的好評(píng)與關(guān)注！ 有三個(gè)CAD二次開(kāi)發(fā)源碼均能用：源碼1(lisp)程序: CAD文字提取到電子表格，（說(shuō)明源碼1.把文字提取到1個(gè)單元格的而且用n隔開(kāi)，）源碼2(lisp)程序: 提取標(biāo)注到文本，源碼3(VBA).提取文字到文本請(qǐng)老師組合成一個(gè)lisp程序：要求把CAD的文字和標(biāo)注都可以分別換行提取到excel中來(lái)或文本文檔中1.源碼1(lisp)程序 (defun c:Q2()(setq ffn (getfiled 寫(xiě)出文件 xls 1)(princ n選取文字.)(setq ss (ssget)(setq ff (open ffn w)(setq i 0)(
2、repeat (sslength ss)(setq ssn (ssname ss i)(setq ssdata (entget ssn)(setq sstyp (cdr (assoc 0 ssdata)(if (or (= sstyp TEXT) (= sstyp MTEXT)(progn(setq txt (cdr (assoc 1 ssdata)(princ txt ff)(princ n ff)(setq i (1+ i) ? ? ?)(close ff)(princ (strcat n寫(xiě)出文件: ffn)(prin1)?源碼2.提取標(biāo)注到文本 (defun c:txtout() (se
3、tq fln (getstring n輸出文件名:) (setq fln (strcat fln .txt) (setq f (open fln w) (setq a (ssget) (setq n (sslength a) (setq index 0) (repeat n (setq el (entget (ssname a index) (setq index (+ index 1) (setq e (assoc 0 el) (if (= DIMENSION (cdr e) (progn (setq txt (cdr (assoc 42 el) (setq txt-1 (rtos txt)
4、 (write-line txt-1 f) ) )(close f)源碼3.提取文字到文本Sub mysel()Dim k, i As IntegerDim hjx() As StringDim sset As AcadSelectionSet 定義選擇集對(duì)象Dim element As AcadEntity 定義選擇集中的元素對(duì)象k = 0If Not IsNull(ThisDrawing.SelectionSets.Item(ss1) ThenSet sset = ThisDrawing.SelectionSets.Item(ss1)sset.Delete 如果選擇集已存在,則刪除End
5、IfSet sset = ThisDrawing.SelectionSets.Add(ss1) 新建一個(gè)選擇集sset.SelectOnScreen 提示用戶選擇For Each element In sset 在選擇集中進(jìn)行循環(huán)k = k + 1ReDim Preserve hjx(k)hjx(k) = GetMTextUnformatString(element.TextString)MsgBox GetMTextUnformatString(hjx(k)Nextsset.DeleteFor i = UBound(hjx) To 0 Step -1MsgBox hjx(i)NextCall
6、 dke(hjx()sset.Delete 刪除選擇集End SubSub dke(ku() As String) 提出文字輸出到c:123.txtDim i As IntegerSet fs = CreateObject(Scripting.FileSystemObject)Set a = fs.createtextfile(c:123.txt, True)Set a = fs.OpenTextFile(c:123.txt, 8)For i = UBound(ku) To 0 Step -1a.WriteLine (ku(i)Nexta.CloseSet fs = NothingMsgBox
7、 完成End SubPublic Function GetMTextUnformatString(MTextString As String) As String Dim s As String Dim RE As Object 獲取Regular Expressions組件 Set RE = ThisDrawing.Application.GetInterfaceObject(Vbscript.RegExp) 忽略大小寫(xiě) RE.IgnoreCase = True 搜索整個(gè)字符串 RE.Global = True s = MTextString 替換字符 RE.Pattern = s = RE
8、.Replace(s, Chr(1) 替換字符 RE.Pattern = s = RE.Replace(s, Chr(2) 替換字符 RE.Pattern = s = RE.Replace(s, Chr(3) 刪除段落縮進(jìn)格式 RE.Pattern = pi(.;*); s = RE.Replace(s, ) 刪除制表符格式 RE.Pattern = pt(.;*); s = RE.Replace(s, ) 刪除堆迭格式 RE.Pattern = S(.;*)(|#|)(.;*); s = RE.Replace(s, $1$3) 刪除字體、顏色、字高、字距、傾斜、字寬、對(duì)齊格式 RE.Patt
9、ern = (F|C|H|T|Q|W|A)(.;*); s = RE.Replace(s, ) 刪除下劃線、刪除線格式 RE.Pattern = (L|O|l|o) s = RE.Replace(s, ) 刪除不間斷空格格式 RE.Pattern = s = RE.Replace(s, ) 刪除換行符格式 RE.Pattern = P s = RE.Replace(s, ) 刪除換行符格式(針對(duì)Shift+Enter格式) RE.Pattern = vbLf s = RE.Replace(s, ) 刪除 RE.Pattern = (|) s = RE.Replace(s, ) 替換回,字符 RE.Pattern = x01 s = RE.Replace(s, ) RE.Pattern = x02 s = RE.Replace(s, ) RE.Pattern = x03 s = RE.Replace(s, ) Set RE = Nothing GetMTextUnformatString = sEnd Function5 / 5
CAD二次開(kāi)發(fā)源碼
