Hello I am using the Journaling function of NX 12 with visual basic, now I am trying to construct two lines, however, after I run my program, no results are shown. May I ask what is wrong with my code?
The following is my code
Thank you
Imports System
Imports NXOpen
Module NXJournal
Sub Main()
Dim p0 As New NXOpen.Point3d(1,2,3)
Dim p1 As New NXOpen.Point3d(4,7,5)
Dim theSession = NXOpen.Session.GetSession()
Dim workPart As NXOpen.Part = theSession.Parts.Work
Dim line1 As NXOpen.Line = workPart.Curves.CreateLine(p0, p1)
End Sub
End Module
After i run your journal, i do get a line drawn, so nothing appears to be wrong with your code.
While it should also work in other environments, i'm just going to make sure it's in the modelling inveronment for the least trouble.
Now, i've added code to fit the window to view the line to better see the line.
Another possible issue i could think of, was that you disabled the layer on which the line was drawn. To ensure this is not the case, i set the line to layer 1. To access the layer manager in nx, you can press ctrl+L, and verify what layers are visible.
Imports System
Imports NXOpen
Module NXJournal
Sub Main()
Dim theSession = NXOpen.Session.GetSession()
Dim workPart As NXOpen.Part = theSession.Parts.Work
' if nx is not in the modeling application, switch to it
If theSession.ApplicationName IsNot "UG_APP_MODELING" Then theSession.ApplicationSwitchImmediate("UG_APP_MODELING")
' create simple points (not smartpoints)
Dim p0 As New NXOpen.Point3d(1,2,3)
Dim p1 As New NXOpen.Point3d(4,7,5)
' create a line in the part
Dim line1 As NXOpen.Line = workPart.Curves.CreateLine(p0, p1)
'set the layer
line1.layer = 1
' fit to the line
workPart.ModelingViews().WorkView().Fit()
End Sub
End Module
Related
The code below is causing some trouble. I have used it on 5 computers and it works fine. My company has now brought 5 more computers and now it doesn't want to work on the new ones. It is supposed to find the dropbox path using the JSON file.
Function DownloadF()
Dim RegEx As Object
Dim MatchColl As Object
Dim DataLine As String
Dim DropboxPath
Const FileNum = 1 ' Assumes no other files are open!!
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Global = True
RegEx.IgnoreCase = False
Open Environ("LOCALAPPDATA") & "\Dropbox\info.json" For Input As #FileNum
Do While Not EOF(FileNum)
Line Input #FileNum, DataLine ' read in data 1 line at a time
' decide what to do with dataline,
' depending on what processing you need to do for each case
Loop
Close #FileNum
RegEx.Pattern = "^.*""path"": ""([^""]*).*"
DropboxPath = Replace(RegEx.Replace(DataLine, "$1"), "", "")
' If there are multiple dropbox accounts on this machine, this will
' only get the first one
DownloadF = DropboxPath & Range("Pathway")
End Function
The above picture is what it is supposed to show but the below is what it returns.
All the settings are the same for excel. Has anyone came across this problem?
Very simple. Cell A1 has an image in it, which I supply through Insert:Picture:From File...
Now I want Cell A3 to automatically show the same picture. I simply can't find a way-- certainly the "=" doesn't work. At this point, I don't care if the images are "links" or embedded, I just want it to work. Can it? Thx.
Edit, 09-01-17, based on Jim K's idea, here's macro code I have installed:
REM ***** BASIC *****
Private oListener as Object
Private cellA1 as Object
Sub AddListener
Dim Doc, Sheet, Cell as Object
Doc = ThisComponent
Sheet = Doc.Sheets.getByName("Sheet1")
cellA1 = Sheet.getCellrangeByName("A1")
'create a listener
oListener = createUnoListener("Modify_","com.sun.star.util.XModifyListener")
'register the listener
cellA1.addModifyListener(oListener)
End Sub
Sub Modify_disposing(oEv)
End Sub
Sub RmvListener
cellA1.removeModifyListener(oListener)
End Sub
' macro jumps here when oListener detects modification of Sheet
Sub Modify_modified(oEv)
Doc = ThisComponent
Sheet = Doc.Sheets.getByIndex(0)
originCell = Sheet.getCellByPosition(0,0)
originValue = originCell.Value
if originValue then
print "originValue is " & originValue
else
print "originValue zero"
end if
End Sub
The problem, ironically, is that it works. It works for integers and {non-value}, I mean an empty cell.
So any integer not zero prints TRUE, zero prints FALSE, and empty cell prints FALSE.
But that's where it quits working-- any kind of string "asdf" also returns FALSE.
Maybe that could be fixed, but there's something a lot worse: When I paste an image in the cell, or use the Insert/Image/From File... menu, or Cut an existing image... Nothing happens! The Sheet Modified business does not trigger the expected routine.
Any hope? Thx.
As you discovered, the solution in my comment does not work, because the Content changed event will not trigger when images are added. I looked into other events as well, but they did not work either.
So instead, we can set up a function that runs periodically. Each time it runs, it checks the count of images, and if any have been added or removed, it calls update_copied_images() below, which currently simply reports the value of cell A1, as in your code.
As explained here, I have not gotten a timer loop to work in Basic without crashing, so we can use Python instead (a better language, so this is not a drawback in my opinion).
import time
from threading import Thread
import uno
COLUMN_A, COLUMN_B, COLUMN_C = 0, 1, 2
FIRST_ROW = 0
def start_counting_images(action_event=None):
t = Thread(target = keep_counting_images)
t.start()
def keep_counting_images():
oDoc = XSCRIPTCONTEXT.getDocument()
oSheet = oDoc.getSheets().getByIndex(0)
oDrawPage = oSheet.getDrawPage()
messageCell = oSheet.getCellByPosition(COLUMN_C, FIRST_ROW)
messageCell.setString("Starting...")
prevCount = -1
while hasattr(oDoc, 'calculateAll'): # keep going until document is closed
count = oDrawPage.Count
if prevCount == -1 or prevCount != count:
prevCount = count
messageCell.setString("Number of Images: " + str(prevCount))
update_copied_images(oSheet)
time.sleep(1)
def update_copied_images(oSheet):
originCell = oSheet.getCellByPosition(COLUMN_A, FIRST_ROW)
originString = originCell.getString()
messageCell = oSheet.getCellByPosition(COLUMN_B, FIRST_ROW)
if len(originString):
messageCell.setString("originString '" + originString + "'")
else:
messageCell.setString("originString length is zero")
g_exportedScripts = start_counting_images,
To run, go to Tools -> Macros -> Run Macro, find the .py file under My Macros where you put this code, and run start_counting_images.
I'm hoping I can get come help from a programmer.
What I want to do is to translate a word report generated by a software, so I turned to macros. I already have a word file containing the original word/phrases and the translated ones.
I 'stole' the code to translate from some forum online, which works great with normal text. My problem is that the text of the report I want to translate is within various "text boxes" and "tables".
I was able to manually remove the tables, but keep the text. This totally ruined the formatting, but I can deal with that latter.
Now, unfortunately I cannot do the same with textboxes. There is no 'delete, but keep the text" function for textboxes.
I can send you the macro code, the original report automatically generated by the software and the file to get all translated words from.
I really appreciate your time.
Ok. This is code that translates normal text.
Sub Translate()
Dim oChanges As Document, oDoc As Document
Dim oTable As Table
Dim oRng As Range
Dim rFindText As Range, rReplacement As Range
Dim i As Long
Dim sFname As String
'Change the path in the line below to reflect the path of the table document
sFname = "C:\Users\user\Desktop\Dictionary.doc"
Set oDoc = ActiveDocument
Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)
Set oTable = oChanges.Tables(1)
For i = 1 To oTable.Rows.Count
Set oRng = oDoc.Range
Set rFindText = oTable.Cell(i, 1).Range
rFindText.End = rFindText.End - 1
Set rReplacement = oTable.Cell(i, 2).Range
rReplacement.End = rReplacement.End - 1
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(findText:=rFindText, _
MatchWholeWord:=True, _
MatchWildcards:=False, _
Forward:=True, _
Wrap:=wdFindContinue) = True
oRng.Text = rReplacement
Loop
End With
Next i
oChanges.Close wdDoNotSaveChanges
End Sub
I'm guessing you'd need to see the format of the document that is being translated, which contains all the tables and text boxes. But it is too large and I'm not sure if I can send it as an attachment here somehow. (sorry, its my first time on this forum). Any advise?
Thanks a lot
JD
Right now i'm making a program that allows you to mod a game more easier. In the regular game you have to open up files and navigate through the animations. I wanted to make it easier. I've already made the other parts of the program but go to the last part that I need help with. I want to be able to grab all forms of the first animation name and then the inside animation name, make that go along with it. So I can make an easy to use editor. I know this would most likely involve regex and I am fairly bad at it, I am also still trying to RE-learn VB.net after not toying with the language for ages. If someone could help me out, i'd be very thankful:
The file I am trying to load:
animation "idle0"
{
animation "idle_yoga";
};
animation "idle1"
{
animation "idle_pants";
};
Here you have a sample code performing what you are after:
Dim dict As Dictionary(Of String, String) = New Dictionary(Of String, String)()
Try
Dim sr As System.IO.StreamReader = New System.IO.StreamReader("path to the file")
Dim line As String
Dim started As Boolean = False
Dim inside As Boolean = False
Dim firstInput As String = ""
Do
line = sr.ReadLine()
If (line IsNot Nothing) Then
If (line.ToLower().Contains("animation")) Then
If (started AndAlso inside) Then
'Animation
Dim curItem As String = line.ToLower().Split(New String() {"animation"}, StringSplitOptions.None)(1).Trim()
If (curItem.Substring(curItem.Length - 1, 1) = ";") Then curItem = curItem.Substring(0, curItem.Length - 1)
curItem = curItem.Replace("""", "")
dict.Add(firstInput, curItem)
started = False
inside = False
ElseIf (Not inside) Then
'Group name
Dim curItem As String = line.ToLower().Split(New String() {"animation"}, StringSplitOptions.None)(1).Trim()
curItem = curItem.Replace("""", "")
firstInput = curItem
started = True
End If
ElseIf (started AndAlso line.Contains("{")) Then
inside = True
End If
End If
Loop Until line Is Nothing
sr.Close()
Catch
End Try
This code reads the information from a file as described (the code you posted line by line) and performs the grouping you want. Finally, I chose a Dictionary (ListBox is perhaps not the best control for that; you might consider to use a ListView better) because the whole point is showing you how can this situation be addressed. I guess that what the code does is pretty clear: you will have to extend/adapt it to your actual requirements, although the main structure should be something on these lines anyway.
I have a need to read a CSV file, and the only language I can use is VBscript.
I'm currently just opening the file and splitting on commas, and it's working OK because there aren't any quoted commas in fields. But I'm aware this is an incredibly fragile solution.
So, is there such a thing as a VBscript module I can use? Somewhere to get a tried-and-tested regular expression that would only split on commas not in quotes?
Any suggestions gratefully received.
VBScript does not have a module system comparable to Perl. However you can open CSV files with ADO and access them like a database table. The code would go something like this:
(The funny comments are solely to fix SO's broken VB syntax highlighting)
Dim conn ''// As ADODB.Connection
Dim rs ''// As ADODB.RecordSet
Dim connStr ''// As String
Dim dataDir ''// As String
dataDir = "C:\" '"
connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dataDir & ";Extended Properties=""text"""
Set conn = CreateObject("ADODB.Connection")
conn.Open(connStr)
Set rs = conn.Execute("SELECT * FROM [data.txt]")
''// do something with the recordset
WScript.Echo rs.Fields.Count & " columns found."
WScript.Echo "---"
WScript.Echo rs.Fields("Col1Name").Value
If Not rs.EOF Then
rs.MoveNext
WScript.Echo rs.Fields("Col3Name").Value
End If
''// explicitly closing stuff is somewhat optional
''// in this script, but consider it a good habit
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
Creating a schema.ini file that exactly describes your input is optimal. If you don't, you force the text driver to guess, and all bets are off if it guesses the wrong thing. The schema.ini must reside in the same directory where your data is.
Mine looked like this:
[data.txt]
Format=Delimited(;)
DecimalSymbol=.
ColNameHeader=True
MaxScanRows=0
Col1=Col1Name Long
Col2=Col2Name Long
Col3=Col3Name Text
Col4=Col4Name Text
and with this data.txt:
a;b;c;d
1;2;"foo bar";"yadayada"
1;2;"sample data";"blah"
I get this output:
C:\>cscript -nologo data.vbs
4 columns found.
---
1
sample data
C:\>
Worth a read in this regard: Much ADO About Text Files off the MSDN.
You can try creating an Excel ODBC Data Source to CSV (Called DSN I think. Its in Control Panel -> Administrative Tools -> ODBC Data Sources. Then on, you can query it using SQL.
I am still unsure if you can get what you want. I mean inserting a string with commas in it as a value for a particular cell.
A regexp:
'Credits go to http://www.codeguru.com/cpp/cpp/algorithms/strings/article.php/c8153/
r.Pattern = ",(?=(?:[^""]*""[^""]*"")*(?![^""]*""))"
It will find all commas that are not inside quotes.
Alternatively, you can use this function which I just adapted for vbs.
call test
Function ParseCSV(StringToParse, Quotes)
Dim i, r(), QuotedItemStart, prevpos
ReDim r(0)
prevpos = 1
For i = 1 To Len(StringToParse)
If Mid(StringToParse, i, 1) = "," Then
If QuotedItemStart = 0 Then
r(UBound(r)) = Trim(Mid(StringToParse, prevpos, i - prevpos))
ReDim Preserve r(UBound(r) + 1)
prevpos = i + 1
End If
Else
If InStr(1, Quotes, Mid(StringToParse, i, 1)) Then
If QuotedItemStart Then
r(UBound(r)) = Trim(Mid(StringToParse, QuotedItemStart, i - QuotedItemStart))
ReDim Preserve r(UBound(r) + 1)
QuotedItemStart = 0
prevpos = i + 2
i = i + 1
Else
QuotedItemStart = i + 1
End If
End If
End If
Next
If prevpos < Len(StringToParse) Then r(UBound(r)) = Trim(Mid(StringToParse, prevpos))
ParseCSV = r
End Function
Sub Test()
Dim i, s
s = ParseCSV("""This is, some text!"",25,""Holy holes!"", 286", """")
For i = LBound(s) To UBound(s)
msgbox s(i)
Next
msgbox "Items: " & CStr(UBound(s) - LBound(s) + 1)
End Sub
To answer the other half of your question, I have a vague recollection that you can use Windows Script Host spread across several WSF files. I have never done it myself, link to MSDN. Not pure VBS, but it should work in 'just' windows, if that was the real constraint.
More links:
Scripting Guys
Wikipedia
'Tutorial'