Change %% in autocad
Hey guys, i have searched this forum in hope for something to help me.What's my problem :
I have many drawings each day (100-500) and i have to load them into a database. But the database gives errors if it finds %% in the drawing.
How can i make a simple script to auto search and replace %%C into Ø , %%D into º and %%p into ±
I'm searching for 3 days now and no result.
And something else, how can i add to the batch to auto delete any layout he finds in the drawing and to center the layout?
this would help me VERY VERY much with my tasks every day becouse it tend to repeat...and it's a time killer thing.
I know that I should use Lisp, i fould that Lisp is installed on my machine but i dont know the syntax of doing such things...
Thanks in advance !!! I don't know if this will work for but try Find/Replace...
From Help Yes i know, but how do I make this into a command so I can include into an existing batch script?
I dont need a new script to do that, i can add this to a Save-as acad 2000 script and while the script will save as acad , it will change the %% also.
Many thanks for the quick response! So , in autocad exists a find/replace command?
just a line of command to find a certain thing and a second command to replace the thing? Here is a VB version
Public Function MText_Unformat(ByVal sTxt As String) As String'------------------------------------------------------------------------------'Remove formatting strings''Value Examples:' \A Sets the alignment value; valid values: 0, 1, 2 (bottom, center, top)' \Cvalue; Changes to the specified color' \Hvalue; Changes to the specified text height' \Hvaluex; Changes to multiple of mtext object's property' \L...\l Turns underline on and off' \O...\o Turns overline on and off' \P Ends paragraph/Carriage return' \Qangle; Changes obliquing angle' \S...^...; Stacks the subsequent text at the \ or ^ symbol' \Tvalue; Adjusts the space between characters' \Wvalue; Changes width factor to produce wide text' \~ Inserts a nonbreaking space' \\ Inserts a backslash' \{...\} Inserts an opening and closing brace' \File name; Changes to the specified font file''------------------------------------------------------------------------------Dim P1 As IntegerDim P2 As IntegerDim P3 As IntegerDim iStart As IntegerDim sComp As StringDim sReplace As StringDim sLittle As String'''''''''''''''''''''''''''''''''''''''Debug.Print sTxt'------------------------------------------------------------------------------'Remove alignment codes'------------------------------------------------------------------------------Select Case Left(sTxt, 4)Case "\A0;", "\A1;", "\A2;" sTxt = Mid(sTxt, P1 + 5)End SelectiStart = 1'------------------------------------------------------------------------------'Replace octal code values with strings'------------------------------------------------------------------------------Do P1 = InStr(sTxt, "%%") If P1 = 0 Then Exit Do Else Select Case Mid(sTxt, P1 + 2, 1) Case "P" sTxt = Replace(sTxt, "%%P", "+or-") Case "D" sTxt = Replace(sTxt, "%%D", " deg") End Select End IfLoopDo P1 = InStr(iStart, sTxt, "\", vbTextCompare) If P1 = 0 Then Exit Do sComp = Mid(sTxt, P1, 2) Select Case sComp Case "\p" P2 = InStr(1, sTxt, ";") sTxt = Mid(sTxt, P2 + 1) Case "\A", "\C", "\f", "\F", "\H", "\Q", "\T", "\W" P2 = InStr(P1 + 2, sTxt, ";", vbTextCompare) P3 = InStr(P1 + 2, sTxt, sComp, vbTextCompare) If P3 = 0 Then sTxt = Left(sTxt, P1 - 1) & Mid(sTxt, P2 + 1) End If Do While P3 > 0 P2 = InStr(P3, sTxt, ";", vbTextCompare) sTxt = Left(sTxt, P3 - 1) & Mid(sTxt, P2 + 1) 'Debug.Print sTxt, sComp P3 = InStr(1, sTxt, sComp, vbTextCompare) Loop 'sTxt = Left(sTxt, P3 - 1) & mid(sTxt, P3 + 1) Case "\L", "\O" sLittle = LCase(sComp) P2 = InStr(P1 + 2, sTxt, sLittle, vbTextCompare) If P2 = 0 Then sTxt = Left(sTxt, P1 - 1) & Mid(sTxt, P1 + 2) Else sTxt = Left(sTxt, P1 - 1) & Mid(sTxt, P1 + 2, P2 - (P1 + 2)) & Mid(sTxt, P2 + 2) End If Case "\S" P2 = InStr(P1 + 2, sTxt, ";", vbTextCompare) P3 = InStr(P1 + 2, sTxt, "/", vbTextCompare) If P3 = 0 Or P3 > P2 Then P3 = InStr(P1 + 2, sTxt, "#", vbTextCompare) End If If P3 = 0 Or P3 > P2 Then P3 = InStr(P1 + 2, sTxt, "^", vbTextCompare) End If sTxt = Left(sTxt, P1 - 1) & Mid(sTxt, P1 + 2, P3 - (P1 + 2)) _ & "/" & Mid(sTxt, P3 + 1, (P2) - (P3 + 1)) & Mid(sTxt, P2 + 1) Case "\U" 'Replace symbols with text sLittle = Mid(sTxt, P1 + 3, 4) Debug.Print sLittle Select Case sLittle Case "2248" sReplace = "ALMOST EQUAL" Case "2220" sReplace = "ANGLE" Case "2104" sReplace = "CENTER LINE" Case "0394" sReplace = "DELTA" Case "0278" sReplace = "ELECTRIC PHASE" Case "E101" sReplace = "FLOW LINE" Case "2261" sReplace = "IDENTITY" Case "E200" sReplace = "INITIAL LENGTH" Case "E102" sReplace = "MONUMENT LINE" Case "2260" sReplace = "NOT EQUAL" Case "2126" sReplace = "OHM" Case "03A9" sReplace = "OMEGA" Case "214A" sReplace = "PROPERTY LINE" Case "2082" sReplace = "SUBSCRIPT2" Case "00B2" sReplace = "SQUARED" Case "00B3" sReplace = "CUBED" End Select sTxt = Replace(sTxt, "\U+" & sLittle, sReplace) Case "\~" sTxt = Replace(sTxt, "\~", " ") Case "\\" iStart = P1 + 2 sTxt = Replace(sTxt, "\\", "\") GoTo Selectagain Case "\P" iStart = P1 + 1 GoTo Selectagain Case Else Exit Do End SelectSelectagain:Loop'------------------------------------------------------------------------------'Replace \P with vbCrLf'------------------------------------------------------------------------------Do P1 = InStr(1, sTxt, "\P", vbTextCompare) If P1 = 0 Then Exit Do Else sTxt = Left(sTxt, P1 - 1) & vbCrLf & Mid(sTxt, P1 + 2) End IfLoopFor iStart = 0 To 1 If iStart = 0 Then sComp = "}" Else sComp = "{" End If P2 = InStr(1, sTxt, sComp) Do While P2 > 0 sTxt = Left(sTxt, P2 - 1) & Mid(sTxt, P2 + 1) P2 = InStr(1, sTxt, sComp) LoopNext iStartMText_Unformat = sTxtEnd Function Just type FIND in the command line. Look for reptext.lsp
http://www.74mph.com/lisp.asp I like zypa would be interested if anyone knows how to pass the "Find" Command the two lines it needs to work, I have asked this before I want to use it in a script.
页:
[1]