[29010707]

Pozdravljeni!
V SW znam uvoziti krivuljo iz Excelove datoteke oziroma txt datoteke. Ne znam pa narisano krivuljo v SW ali AutoCADu eksportirati v Excel oziroma txt datoteko. A mi zna kdo pomagati?
Lp!

[baklava]

[ManiaC]

Sem ti spisal en kratek macro za SolidWorks, da ti naredi to.

Za uporabo pa naredi naslednje:
1.označen moraš imeti sketch, iz katerega hočeš povleči točke
2.pojdo pod tools-->macro->run, ter poišči datoteko Tocke.swp kamor si si le to datoteko shranil
3. točke najdeš v datoteki na c:\Tocke.txt

deluje za navaden sketch kot tudi za 3D sketch

http://www.megaupload.com/?d=U3ZAWL1R

p.s. zakaj ne morem na tem portalu pripeti .zip datoteko, ki jo zgenerira winrar, napiše mi da ta datoteki ni .zip, kljub temu da je.

[29010707]

Hvala obema.
Majhen problem pri List v AutoCadu je, da moraš brisati nepotreben tekst in ker imam dosti točk mi to predstavlja kar delo.
Macro pa v mojem SW 2007 ne deluje, oziroma na c: ne najdem nobene txt datoteke s točkami, tako da ne vem kje je problem.

[baklava]

[ManiaC]

Sam imam sicer sw 2009, vendar mislim da bi moralo delovati tudi na 2007, saj je macro spisan v vba in bi moral delovati na starejših sw.

Pripenjam sliko, po kateri meni deluje:



Lahko pa probaš sam spisati macro, ter ga nato z debuggerjem pognat. Pa mi povej, če ti slučajno najde kakšno napako.

To narediš tako, da daš tools->macro->new in vpišeš ime macroja.
Nato pa kopiraj spodnji tekst in pritisni tipko play(skica mora biti še vedno označena):

Sub ProcessSketchPoint(SwApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swSkPt As SldWorks.SketchPoint)
Dim vID As Variant
Dim swSketch As SldWorks.Sketch
Dim nPt(2) As Double
Dim vPt As Variant

Set swSketch = swSkPt.GetSketch

'pridobi sketch informacije
vID = swSkPt.GetID

'shranimo posamezno točko v matriko nPt
nPt(0) = swSkPt.x: nPt(1) = swSkPt.Y: nPt(2) = swSkPt.Z

'zapiše točke v datoteke
'množimo jih s 1000 da dobimo mm, osnovne enote so metri
Write #1, "x=" & nPt(0) * 1000 & " " & "y=" & nPt(1) * 1000 & " " & "z=" & nPt(2) * 1000


End Sub

Sub main()
Dim SwApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFeat As SldWorks.Feature
Dim swSketch As SldWorks.Sketch
Dim vSkPtArr As Variant
Dim vSkPt As Variant
Dim swSkPt As SldWorks.SketchPoint

Set SwApp = Application.SldWorks
Set swModel = SwApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swFeat = swSelMgr.GetSelectedObject6(1, 0)
Set swSketch = swFeat.GetSpecificFeature2

'preverjamo, če točke v sketchu sploh obstajajo
vSkPtArr = swSketch.GetSketchPoints2: If IsEmpty(vSkPtArr) Then Exit Sub

'pot do datoteke, kamor bodo shranjene točke
Open "c:\tocke.txt" For Output As #1

'For zanka, da dobimo vse točke v sketchu
For Each vSkPt In vSkPtArr

Set swSkPt = vSkPt
ProcessSketchPoint SwApp, swModel, swSkPt

Next vSkPt

'zapremo datoteko, ko končani operaciji
Close #1
End Sub

[29010707]

Pri izdelavi macroja mi, ko pritisnem tipko play (run) javi naslednjo napako:

Compile error
Ambigiuous name detected: main

Kaj pa to pomeni pa ne vem.

Glede izvoza točk v excelu in nadaljni obdelavi v excelu pa imam problem, ker v excelu ne znam brisati praznih celic. Primer
A B
5 5
0 2
0 4
2
0
0
4
Kako lahko v excelu prenesem vrednosti brez praznih celic oziroma nul v naslednji stolpec in to tako, da vmes ni praznih celic oziroma vrstic.
Upam da je razumljivo napisano.

[ManiaC]

probaj to kodo(odstranil sem številke pri modeldoc2 in podobnih, mogoče je to problem da ne deluje pri starejši verziji). Če pa še vedno to ne bo delovalo, pa bom probal pogledat jutri zvečer ko pridem domov na računalniku, kjer imam sw 2007.

Sub ProcessSketchPoint(SwApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc, swSkPt As SldWorks.SketchPoint)
Dim vID As Variant
Dim swSketch As SldWorks.Sketch
Dim nPt(2) As Double
Dim vPt As Variant

Set swSketch = swSkPt.GetSketch

'pridobi sketch informacije
vID = swSkPt.GetID

'shranimo posamezno točko v matriko nPt
nPt(0) = swSkPt.x: nPt(1) = swSkPt.Y: nPt(2) = swSkPt.Z

'zapiše točke v datoteke
'množimo jih s 1000 da dobimo mm, osnovne enote so metri
Write #1, "x=" & nPt(0) * 1000 & " " & "y=" & nPt(1) * 1000 & " " & "z=" & nPt(2) * 1000


End Sub

Sub main()
Dim SwApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFeat As SldWorks.Feature
Dim swSketch As SldWorks.Sketch
Dim vSkPtArr As Variant
Dim vSkPt As Variant
Dim swSkPt As SldWorks.SketchPoint

Set SwApp = Application.SldWorks
Set swModel = SwApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swFeat = swSelMgr.GetSelectedObject(1)
Set swSketch = swFeat.GetSpecificFeature

'preverjamo, če točke v sketchu sploh obstajajo
vSkPtArr = swSketch.GetSketchPoints: If IsEmpty(vSkPtArr) Then Exit Sub

'pot do datoteke, kamor bodo shranjene točke
Open "c:\tocke.txt" For Output As #1

'For zanka, da dobimo vse točke v sketchu
For Each vSkPt In vSkPtArr

Set swSkPt = vSkPt
ProcessSketchPoint SwApp, swModel, swSkPt

Next vSkPt

'zapremo datoteko, ko končani operaciji
Close #1
End Sub

[29010707]

Sem ponovno probal, pa mi ne deluje. Ne vem....

[29010707]

Deluje!
Hvala ManiaC!