Block invoeren door middel van dimscale

[Darklegasy]

Hallo,

Ik ben vrij nieuw in vba maar heb besloten me hier eens in te gaan verdiepen omdat wij een oude vba tool hebben om symbolen in te voeren nu wil ik deze gaan uitbreiden en aanpassen op bepaalde vlakken:

Nu is mijn eerste probleem het invoegen van een symbool via een knop op basis van de dimscale


Dit is wat ik nu heb om de dimscale in te stellen vanuit een lijst

Voorheen stelde je hiermee de !sch in (ThisDrawing.Sendcommand (setq sch 50) ).

Code Selecteer Uitklappen


Private Sub cboSchaal_Change() 'schaal van de tekening instellen
    If Me.cboSchaal.ListIndex = 0 Then
        ThisDrawing.SetVariable "dimscale", 50
    End If
    If Me.cboSchaal.ListIndex = 1 Then
        ThisDrawing.SetVariable "dimscale", 100
    End If
    If Me.cboSchaal.ListIndex = 2 Then
        ThisDrawing.SetVariable "dimscale", 200
    End If
End Sub


Dit is de code waarmee het block momenteel werd ingevoerd dit gaat dus niet werken met simpel de !sch te vervangen met dimscale aangezien dit geen numerieke waar is.
ik zal hiervoor de een nieuw script moeten hebben.

Code Selecteer Uitklappen


Private Sub cmd01r_Click()
    Me.Hide
    ThisDrawing.SendCommand "-layer" + vbCr + "s" + vbCr + "64---1--telecom-datainst" + vbCr + vbCr
    ThisDrawing.SendCommand "-insert" + vbCr + "k:/bibdata/nieuw/DATA1R.DWG" + vbCr + "s" + vbCr + "!sch" + vbCr
    Me.Show
End Sub


Wie kan mij hier in helpen

Alvast bedankt

[sschevers]

Darklegasy,

Welkom op het forum.
Voor het toevoegen van een block in je tekening kijk eens naar de volgende thread
http://www.cadsite.be/smf/index.php?topic=3414.0

Hier staan ook een aantal links in voor uitleg over vba (met dank aan HofCad).

Probeer SendCommand te vermijden. De code wordt niet synchroon uitgevoerd zodat de resultaten zeer onvoorspelbaar zijn. Het current zetten van een laag en het toevoegen van een block kan allemaal met native vba code in autocad.

succes

stephan

[Darklegasy]

Ik zal binnenkort toch maar eens een cursus of zo moeten gaan volgen....

Ik kan het niet vinden in deze topic

Ik werk met autocad 2010 als ik hier in vba kijk voor sugesties voor commandos (ctrl + spatie) kom ik hierin geen InsertBlock in voor ook bij alles wat ik probeer gaat hij bij een aantal van deze commandos een foutmelding geven als ik wil gaan testen

kan iemand me helpen met een stuk script en hierbij een uitleg wat wat doet?

[sschevers]

ThisDrawing.ModelSpace.insertBlock daar kun je het terug vinden.

Bekijk de voorbeeld projecten eens die hofcad heeft meegestuurd.
HofCad01.dvb en Hofcad02.dvb

Ik denk dat je daar een heel eind mee kan komen. Overigens zijn de boeken van Ronald Boeklagen ook een aanrader.
Nu je toch gaat leren is het misschien een idee om over te stappen naar VB.net. Vba is "end of live" in autocad. Het is niet duidelijk wanneer men er mee stopt maar het staat vast dat dit gaat gebeuren in de nabije toekomst.

Bij CadCollege (Ronald Boeklagen) kun je cursussen volgen in VB.net in combinatie met Autocad.

succes

stephan

[Darklegasy]

Zojuist intern overlegd en ga binnekort waarschijnlijk een cursus volgen bij cadcollege voor vba.net basis

nu mijn vraag dat wij voorlopig verder kunnen oldskool zeg maar:

Is het mogelijk de regel hiervoor te plaatsen om de !sch in te stellen op basis van de ingestelde Dimscale?

ThisDrawing.SendCommand "-layer" + vbCr + "s" + vbCr + "64---1--telecom-datainst" + vbCr + vbCr
ThisDrawing.SendCommand "-insert" + vbCr + "k:/bibdata/nieuw/DATA1L.DWG" + vbCr + "s" + vbCr + "!sch" + vbCr

Of alternatief stukje code

(werkt .net binnen de zelfde omgeving als waar je vba schrijf? of is dit een apparte aplicatie en waar kan je deze dan evt vinden?)

[sschevers]

Code Selecteer Uitklappen


Option Explicit

Public Sub Test()
   Dim insPoint As Double
   
   Set insPoint = ThisDrawing.Utility.GetPoint("Klik een punt om een symbool in te voegen:")
   
   PlaatsSymbool "k:/bibdata/nieuw/DATA1L.DWG", insPoint, "64---1--telecom-datainst"
   
End Sub

Public Sub PlaatsSymbool(symboolNaam As String, insPoint As Double, laagnaam As String)
   Dim space As AcadBlock
   Dim newSymb As AcadBlockReference
   Dim newSymb As AcadBlockReference
   Dim dimScale As Double

   If ThisDrawing.ActiveSpace = acModelSpace Then
      Set space = ThisDrawing.ModelSpace
   Else
      If ThisDrawing.MSpace Then
         Set space = ThisDrawing.ModelSpace
      Else
         Set space = ThisDrawing.PaperSpace
      End If
   End If

   'ophalen van dimscale
   dimScale = CDbl(ThisDrawing.GetVariable("DIMSCALE"))
   
   'plaaten van symbool
   Set newSymb = space.InsertBlock(insPoint, symboolNaam, dimScale, dimScale, dimScale, 0#)
   
   'plaats symbool op de juiste laag
   newSymb.Layer = laagnaam
   'symbool updaten
   newSymb.Update
   

End Sub



Met bovenstaande code moet je een heel eind komen.

Om in VB.Net te programmeren heb je Visual Studio nodig. Je kunt ook de Express editie gebruiken die is gratis. Je kunt downloaden bij Microsoft. Als je cursus gaat volgen zal men je vast vertellen wat je exact nodig hebt.


succes

stephan

[Darklegasy]

Bedankt ik ga hier eens wat mee proberen