CamBam
News:
 
*
Welcome, Guest. Please login or register.
Did you miss your activation email?
December 14, 2019, 00:08:50 am


Login with username, password and session length


Pages: [1] 2 3 ... 6
  Print  
Author Topic: [VBS - C# - VB .net] parts of code (snippet)  (Read 63641 times)
dh42
Administrator
CNC Jedi
*****
Offline Offline

Posts: 5676



View Profile WWW
« on: January 03, 2014, 21:33:03 pm »

Index

Language-Title
Link-VB Script-Call an external application
Link-VB Script-capture mouse click (with snap)
Link-VB Script-Convert Drawing coordinates (drawing units) of a given point in Display coordinates (in pixels)
Link-VB Script-Create a new surface
Link-VB Script-Detecting whether a polyline is contained in another
Link-VB Script-EntityDragEditMode
Link-VB Script-EntityMoveEditMode
Link-VB Script-Find the distance and angle between 2 points (2D on XY axis)
Link-VB Script-Found the MOP names in the active part
Link-VB Script-Get points & faces from surface objects
Link-VB Script-Get the full path of the current drawing
Link-VB Script-How to disable Menu and toolbar
Link-VB Script-Insert a sub menu
Link-VB Script-Line Edit Mode
Link-VB Script-Measure Edit Mode
Link-VB Script-Move an Entity from a layer to another
Link-VB Script-Public Function DrawingToScreen(ByVal pDrawing As Point3F) As PointF
Link-VB Script-Public Function ScreenToDrawing(ByVal pScreen As PointF) As Point3F
Link-VB Script-RichMessageBox
Link-VB Script-Scan the parts and the MOPs to get the ID of all the shapes used
Link-VB Script-Create a specific Translation Key
Link-VB Script-Get info about CamBam and about a plugin.
Link-VB Script-Trim Drawing Entities (3D).
Link-VB Script-create REGION from polylines.
Link-VB Script-Write polylines datas in a text file
Link-VB Script-Create Silhouette
Link-VB Script-Plane Slice
Link-VB Script-Toolpaths To Geometry
Link-VB Script-Construct a line perpendicular to another
Link-VB Script-"built in" menu name
Link-VB Script-PolylineTrim() & PolylineSubtract()
Link-VB Script-Using Windows registry with Linux
Link-VB Script-Scan existing layers, create MOP from layer objects
Link-VB Script-Draw a disk as surface object
Link-VB Script-Points contained in a polyline/polyrectangle
Link-C#-Delete a layer
Link-C#-using Worker Threads
Link-C#-Using tabs

(Thanks to BaNoBi  Wink)

Hello,

I create this topic to add parts of code in bulk (vbs, vb .net, C#)

Find the distance and angle between 2 points (2D on XY axis)

Code:
' New CamBam VBScript
'dh42

sub main

'find the distance between 2 points (2D on XY axis)

dim v as Vector2F

dim a as Point2F = New Point2F(0,0)
dim b as Point2F = New Point2F(1,-15)

dim l as double
dim angle as double

v = New Vector2F(a,b)

l = v.Length 'return length

app.log(l)

angle = v.Angle

' angle = 0 to 180 in 2 uppers cadran (Y+)
' 0 to -180 in 2 bottom cadran (Y-)

app.log(angle/(Math.Pi/180))


end sub

You can do the same for 3D mesuring by using a Vector3F instead of a Vector2F. In this case the Point2F arguments are replaced by Point3F, and there is no Angle property for the Vector3F.

++
David
« Last Edit: October 01, 2019, 16:25:57 pm by dh42 » Logged
lloydsp
CNC Jedi
*****
Offline Offline

Posts: 8085



View Profile
« Reply #1 on: January 03, 2014, 21:49:52 pm »

Thanks, it's in the library.  (well... in the folder.  Later to make it part of a library <G>)

LLoyd
Logged

"Pyro for Fun and Profit for More Than Fifty Years"
dh42
Administrator
CNC Jedi
*****
Offline Offline

Posts: 5676



View Profile WWW
« Reply #2 on: January 03, 2014, 22:03:09 pm »

detecting whether a polyline is contained in another.

info in the code ; use the attached file to do tests.

Code:
' dh42 / 12/2013

' détecter si une polyligne est contenue dans une autre
' si intersection des 2 polylignes, la polyligne sera
' considérée comme contenue ; il faudra donc aussi
' tester si il y a intesection.

' ce code ne fonctionne qu'avec des polylignes, il faudra donc
' convertir tous les objets de dessin en polyligne au préalable.
' utilisez le fichier .cb en pièce jointe pour tester.
' le résultat sort dans la fenêtre de messages.
'-----------------------------------------------------------------------------
' detecting whether a polyline is contained in another.
' If intersection of two polylines, the polyline will be considered contained,
' in this case it will therefore also needed to test  if they intesect.

' This code works only with polylines
' use the sample .cb file in attachment to test this script

sub main


'créer une polyligne conteneur mais sans l'afficher, ce qui n'empèche pas d'utiliser
'la polyligne créée (mais elle ne sera pas sélectionnée par SelectAll...)

' Create a polyline 'container' but without display it, which does not preclude the ability to use it.
'(but it will not be selected by SelectAll ...)

dim conteneur = new Polyline()

conteneur.Add(-79,14,0)
conteneur.Add(-4,14,0)
conteneur.Add(-4,60,0)
conteneur.Add(-79,60,0)
conteneur.Closed=True


dim ent as Entity

'selectionne toutes les entitées du calque courant
'select all entities on active layer

SelectAllLayerGeometry(activelayer())

dim p = new Polyline()

dim b1 as boolean ' contenu (is contained)
dim b2 as boolean ' intersection (intersect)
dim rep as string ' chaine de réponse (return string)

for each ent in view.SelectedEntities 'scanner la sélection (scan for entities in the selection)

p = ent ' convert 'pointer entity' -> 'pointer Polyligne'

'retourne vrai si p est incluse dans 'conteneur' ou si intersection avec lui.
' return True if p is contained or intersect with the 'container'.

b1 = conteneur.PolylineInsidePolyline(p)

'retourne vrai si intersection entre les 2.
'return True if p intersect with the 'container'

b2 = conteneur.Intersects(p)

rep = "PolyLigne: " & p.ID & " Contenue: " & b1 & " - Intersection: " & b2

app.log(rep) 'sortie dans fenetre de messages (output to message windows)

next ent

'affiche le conteneur (qui n'a pas été sélectionné lors de la sélection
' du contenu du calque car il n'était pas affiché à ce moment)

'displays the 'container' (it was not selected when selecting
'the layer's content because it was not displayedat this time )

doc.Add(conteneur)

end sub


++
David

* testfile.cb (2.24 KB - downloaded 227 times.)
Logged
dh42
Administrator
CNC Jedi
*****
Offline Offline

Posts: 5676



View Profile WWW
« Reply #3 on: January 12, 2014, 17:25:01 pm »

Insert a sub menu.

This code (VB .net) insert a sub menu named "Numerical move" in both main and context menu. The new item is added in the sub menu "Transform"



Code:
Public Shared Sub InitPlugin(ByRef ui As CamBamUI)

        Dim mi As New ToolStripMenuItem()   'the new menu entry (item)
        mi.Text = "Numerical move"
        mi.ShortcutKeyDisplayString = "Ctrl+Maj+M"
        mi.ShortcutKeys = Keys.Control + Keys.Shift + Keys.M

        Dim ctxmi As New ToolStripMenuItem()   'the new context menu entry (item)
        ctxmi.Text = mi.Text
        ctxmi.ShortcutKeyDisplayString = mi.ShortcutKeyDisplayString
        ctxmi.ShortcutKeys = mi.ShortcutKeys

        Dim mnuTransform As ToolStripMenuItem
        mnuTransform = ui.Menus.mnuEdit.DropDownItems.Item(13)  'get a pointer to the 'transform' item in the edit menu
        mnuTransform.DropDownItems.Insert(1, mi)    'insert the new entry at position 1 in the sub menu.

        Dim ctxmnuTransform As ToolStripMenuItem

        ctxmnuTransform = ui.ViewContextMenus.ViewContextMenu.Items.Item(1) 'get a pointer to the 'transform' item in the view context menu
        ctxmnuTransform.DropDownItems.Insert(1, ctxmi)  'insert the new entry at position 1 in the context sub menu.

        AddHandler mi.Click, AddressOf plugin_clicked   'add a handler that call the sub 'plugin_clicked' if the main item is used.
        AddHandler ctxmi.Click, AddressOf plugin_clicked    'add a handler that call the sub 'plugin_clicked' if the context item is used.

    End Sub

++
David
Logged
dh42
Administrator
CNC Jedi
*****
Offline Offline

Posts: 5676



View Profile WWW
« Reply #4 on: July 19, 2014, 20:22:49 pm »

Found the MOP names in the active part. (VB script)

Code:
' New CamBam VBScript
' give the name of the MOP in the active part.

sub main

Dim current_part As CAMPart
Dim moplist as MachineOps 'a list of MOP
Dim mop As MachineOp    'a mop

'insure that a part exists to avoid error, create one if none.

CamBamUI.MainUI.CADFileTree.CADFile.EnsureActivePart(False)

'get a pointer to the current part

current_part = CamBamUI.MainUI.CADFileTree.CADFile.ActivePart

'get a pointer to the MOP list in this part

moplist = current_part.MachineOps


'scan the MOPs in the current part and give the name.

For Each mop In moplist
            MsgBox(mop.Name)
Next

end sub

Logged
dh42
Administrator
CNC Jedi
*****
Offline Offline

Posts: 5676



View Profile WWW
« Reply #5 on: July 19, 2014, 22:56:59 pm »

Call an external application (VB script)

Create a text file then run the notepad to view the new created file.

Code:
' New CamBam VBScript
' test script (witout security)

' create a texte file then run the notepad to view the new created file.

sub main

Dim procID As Integer
Dim fname as string = "c:\mytextfile.txt"


CreatFile(fname) ' call a sub to create a text file in c:\ for test

msgbox("file created",,"")

' run the notepad and pass the textfile as argument to it.
' true and -1 are needed if you want that the vbscript wait until the external app is closed.

procID = Shell("notepad.exe c:\mytextfile.txt", AppWinStyle.NormalFocus, true, -1)

msgbox("external process finished",,"")

end sub

sub CreatFile(f)

'create a new or append a existing textfile

dim txt as string
dim EOL as string = chr(13) & chr(10) ' end of line and carriage return

txt = "abcdef" & EOL & "kjhjhflsj" & EOL & "12354843" & EOL 'the text to write in the file

My.Computer.FileSystem.WriteAllText (f, txt, True) 'write in the file

end sub
Logged
dh42
Administrator
CNC Jedi
*****
Offline Offline

Posts: 5676



View Profile WWW
« Reply #6 on: July 19, 2014, 22:59:59 pm »

scan the parts and the MOPs to get the ID of all the shapes used (VBscript)

Code:
sub main
        ' scan the parts and the mops to get the ID of the shapes used.

        Dim all_parts As CamBam.CAM.CAMParts    'main list of all the parts in the drawing
        Dim prt As CamBam.CAM.CAMPart

        Dim all_PartMop As CamBam.CAM.MachineOps    'main list of all the MOP in a part
        Dim mop As CamBam.CAM.MachineOp

        Dim pocketmop As CamBam.CAM.MOPPocket
        Dim profilmop As CamBam.CAM.MOPProfile
        Dim engravemop As CamBam.CAM.MOPEngrave
        Dim drillmop As CamBam.CAM.MOPDrill
        Dim surfacemop As CamBam.CAM.MOP3DSurface

        Dim msg As String

        all_parts = view.CADFile.Parts

        'scan all parts in the drawing
        For Each prt In all_parts


            msg = prt.Name & "    Enabled: " & prt.Enabled & "    nestID: " & prt.Nesting.PointListID
            app.log(msg)

            all_PartMop = prt.MachineOps

            'scan all mop in the part
            For Each mop In all_PartMop
                msg = "        - " & mop.Name & "   Enabled: " & mop.Enabled & "    Type: " & mop.MOPTypeName
                app.log(msg)

                Select Case mop.MOPTypeName
                    Case "Pocket"
                        pocketmop = mop
                        msg = "            ID: " & IdtoString(pocketmop.PrimitiveIds)
                    Case "Profile"
                        profilmop = mop
                        msg = "            ID: " & IdtoString(profilmop.PrimitiveIds)

                    Case "Engrave"
                        engravemop = mop
                        msg = "            ID: " & IdtoString(engravemop.PrimitiveIds)

                    Case "Drill"
                        drillmop = mop
                        msg = "            ID: " & IdtoString(drillmop.PrimitiveIds)

                    Case "3DSurface"
                        surfacemop = mop
                        msg = "            ID: " & IdtoString(surfacemop.PrimitiveIds) & vbNewLine
                        msg += "           Boundary: " & IdtoString(surfacemop.BoundaryShapeIds)

                End Select

                app.log(msg)

            Next mop

            app.log("")

        Next (prt)

End Sub

Public Function IdtoString(list() As Integer) As String

Dim s As String = ""

For Each i As Integer In list
s += Str(i) & ", "
Next

Return s

End Function
Logged
dh42
Administrator
CNC Jedi
*****
Offline Offline

Posts: 5676



View Profile WWW
« Reply #7 on: July 19, 2014, 23:01:52 pm »

Get the full path of the current drawing (VB script)

Code:
' New CamBam VBScript

sub main

Dim newdoc = view.CADFile
        Dim p As String
        p = newdoc.Filename
app.log(p)

end sub

C# version (to use for Linux compatibility)
http://www.cambam.co.uk/forum/index.php?topic=3878.msg48681#msg48681
« Last Edit: October 19, 2016, 22:36:29 pm by dh42 » Logged
lloydsp
CNC Jedi
*****
Offline Offline

Posts: 8085



View Profile
« Reply #8 on: July 19, 2014, 23:07:42 pm »

Wow!  You've been busy, David!

Lloyd
Logged

"Pyro for Fun and Profit for More Than Fifty Years"
dh42
Administrator
CNC Jedi
*****
Offline Offline

Posts: 5676



View Profile WWW
« Reply #9 on: July 19, 2014, 23:29:35 pm »

Move an Entity from a layer to another

before running the script:

create a layer named "Layer1" (without quotes) -> the target layer
create another layer (or use an existing layer set as active) -> the source layer.

Code:
' New CamBam VBScript

' avant de lancer le script:

' créer un calque et le nommer "Layer1" (sans les guillemets) ce sera le calque de destination
' rendre un autre calque courant (c'est sur celui la que sera dessinée l'objet à déplacer)

' before running the script:
' create a layer named "Layer1" (without quotes) -> the target layer
' create another layer (or use an existing layer set as active) -> the source layer.

sub main

' dessine un cercle sur le calque courant
' draw a circle on the active layer

dim cercle1 as Circle = New Circle()
dim c as Point3F
dim ent as Entity

c.x=0
c.y=0
c.z=0

cercle1.center = c
cercle1.diameter = 50.0

doc.add(cercle1)

msgbox("The circle is on the current layer")

dim dest_Layer as Layer
dim l_name as string = "Layer1"

SetActiveLayer(l_name)

dest_Layer = ActiveLayer() 'get the pointer to this layer

view.RefreshView()

msgbox ("Layer1 is set as active")


MoveEntity( cercle1, dest_layer)


end sub

'----------------------------------------------------------

Sub MoveEntity( byref e as Entity, byref d as Layer)

'déplace l'objet "e" de type Entity de son calque d'origine vers
'le calque "d" passé en argument

'move entity (e) from its layer to the given layer (d)

dim src_layer as Layer

'récup le pointeur vers le calque source de l'objet.
' get a pointer on the source layer of the entity.

src_layer = e.Layer

'si calque source = calque cible, sortir
' exit if source/target are the same

if src_layer.name = d.name then
exit sub
end if

'suprime l'entity de l'ancien calque "src_layer"
'remove the entity from the list of entities of its layer
 
src_layer.Entities.remove(e)

' et la met sur le nouveau.
' add this entity to the list of entities of the current layer

d.Entities.Add(e) 
       
End sub
Logged
dh42
Administrator
CNC Jedi
*****
Offline Offline

Posts: 5676



View Profile WWW
« Reply #10 on: July 20, 2014, 00:04:49 am »

Get points & faces from surface objects (VBscript)

Code:
' New CamBam VBScript

sub main

'return points and triangle info about selected surfaces objects
'hit ESC to stop

dim ent as entity
dim surf as surface

dim plist as Point3FArray = new Point3FArray()
'dim flist as TriangleFace()
dim pt as Point3F
dim f as TriangleFace

for each ent in view.SelectedEntities

if typeof ent is surface

app.log("Points  Surface ID: " & ent.ID)
app.log("")

surf = ent
plist = surf.Points

for each pt in plist

app.log("X: " & pt.x & "  Y: " & pt.y & "  Z: " & pt.z)

'exit if ESC is pressed
if CamBam.UI.CamBamUI.GetKeyState(27) < 0 then
exit sub
end if


next pt

for each f in surf.Faces

app.log("A: " & f.A & "  B: " & f.B & "  C: " & f.C)

if CamBam.UI.CamBamUI.GetKeyState(27) < 0 then
exit sub
end if

next f

end if

next


end sub
Logged
dh42
Administrator
CNC Jedi
*****
Offline Offline

Posts: 5676



View Profile WWW
« Reply #11 on: July 20, 2014, 00:09:21 am »

Create a new surface (VBscript)

Code:
' create surfaces test

sub main

dim plist as Point3FArray = new Point3FArray()
dim flist(0) as TriangleFace

'create a new surface object
dim surf as surface = new surface

'create a pointlist and add 3 points

dim pt as point3F = new Point3F(0,0,0)
plist.add(pt)

pt = new point3F(10,0,0)
plist.add(pt)

pt = new point3F(5,10,0)
plist.add(pt)

'add the point list to the surface object
surf.Points = plist

'fit the faces array with the triangle data

flist(0).A = 0
flist(0).B = 1
flist(0).C = 2

'add the surface list to the surface object
surf.Faces = flist

'add the surface object to the document
doc.add(surf)


end sub
Logged
dh42
Administrator
CNC Jedi
*****
Offline Offline

Posts: 5676



View Profile WWW
« Reply #12 on: July 20, 2014, 00:12:48 am »

capture mouse click (with snap) (VB script)

Code:
' CamBam VBScript

' capture mouse click (with snap)
' thanks to "glarenzie" for the inspiration ;)



dim pl as New PointList() '(must be "shared" in a plugin)

sub main()

dim edmode as New PointSelectEditMode(CamBamUI.MainUI.ActiveView)
dim nb_pt as integer = 3 'number of points to read

edmode.DefaultValue = vbNull
edmode.Prompt = "Select a point"
    AddHandler edmode.OnReturnOK, AddressOf point_clicked

CamBamUI.MainUI.ActiveView.SetEditMode(edmode) 'run the point edit mode

do
'repeat until all the points are clicked ( Sleep(10) in plugin)

if pl.Points.Count < nb_pt then
edmode.Repeat()
CamBamUI.MainUI.ActiveView.SetEditMode(edmode)
else
exit do 'the expected number of points have been clicked
end if
System.Windows.Forms.Application.DoEvents()
loop

CamBam.ThisApplication.AddLogMessage(4,"Nb of points: " & pl.Points.Count)

for each p as Point3F in pl.Points()
CamBam.ThisApplication.AddLogMessage(4,"x: " & p.X & "    y: " & p.Y)
next


end sub

Sub point_clicked(ByVal sender As Object, ByVal e As EventArgs )

        Dim ClickedPoint As Point3F

        ClickedPoint = sender.ReturnValue

        pl.add(ClickedPoint) 'add the new data in a shared PointList

        CamBamUI.MainUI.ActiveView.RepaintEditMode()

End Sub
Logged
dh42
Administrator
CNC Jedi
*****
Offline Offline

Posts: 5676



View Profile WWW
« Reply #13 on: July 20, 2014, 00:15:14 am »

Wow!  You've been busy, David!

Lloyd

Yes, some experiments ...  Grin

++
David
Logged
dh42
Administrator
CNC Jedi
*****
Offline Offline

Posts: 5676



View Profile WWW
« Reply #14 on: August 03, 2014, 21:40:33 pm »

Line Edit Mode & Measure Edit Mode (VBscript)

Some experiments with this 2 edit mode.

Line Edit Mode

Code:
'Line edit mode

dim clicked as boolean = false
dim aborted as boolean = false

sub main

dim edmode as New LineEditMode(view)

edmode.DefaultValue = vbNull
edmode.Prompt = "Sélectionnez les points de départ et d'arrivée"
        AddHandler edmode.OnReturnOK, AddressOf point_clicked

AddHandler edmode.OnReturnCancel, AddressOf point_clicked_clr

CamBamUI.MainUI.ActiveView.SetEditMode(edmode)

'wait until the selection is finished or aborted
do while clicked = false

if aborted = true then
exit do
end if

System.Windows.Forms.Application.DoEvents()

loop

msgbox("end")

end sub

Sub point_clicked(ByVal sender As Object, ByVal e As EventArgs)

        Dim l As Line
Dim coord as string
Dim pt as point3F

        l = sender.returnvalue

        CamBamUI.MainUI.ActiveView.RepaintEditMode()

msgbox(l.Points.count)

for each pt in l.points

coord = "X: " & str(pt.x) & "  Y: " & str(pt.y)

app.log(coord)

next pt

clicked = true

End Sub

Sub point_clicked_clr(ByVal sender As Object, ByVal e As EventArgs)

    aborted = true
    msgbox("aborted")

End Sub

Measure Edit Mode

Code:
'Mesure edit mode

sub main

dim edmode as New MeasureEditMode(view)

edmode.DefaultValue = vbNull
AddHandler edmode.OnReturnOK, AddressOf point_clicked

AddHandler edmode.OnReturnCancel, AddressOf point_clicked_clr

CamBamUI.MainUI.ActiveView.SetEditMode(edmode)


end sub

Sub point_clicked(ByVal sender As Object, ByVal e As EventArgs)

        Dim mPoint As Point3F()

        mPoint = sender.returnvalue

        MsgBox("X1: " & mPoint(0).x & "    Y1: " & mPoint(0).y)
        MsgBox("X2: " & mPoint(1).x & "    Y2: " & mPoint(1).y)

        CamBamUI.MainUI.ActiveView.RepaintEditMode()


End Sub

Sub point_clicked_clr(ByVal sender As Object, ByVal e As EventArgs)

msgbox("abort")
        

End Sub

Line edit mode is as polyline drawing ; Esc abort, Enter or middle MB validate and "C" validate too (but also run the circle .. Huh)

++
David
« Last Edit: August 03, 2014, 21:43:09 pm by dh42 » Logged
Pages: [1] 2 3 ... 6
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines

Valid XHTML 1.0! Valid CSS! Dilber MC Theme by HarzeM
Page created in 0.183 seconds with 19 queries.

Copyright © 2018 HexRay Ltd. | Sitemap