1 275
Subscribers
-124 hours
+37 days
+630 days
Posts Archive
1 275
ααΆααααα‘αααααααααααααΆαα ααΎααααΈααα
αΆααααααΆααΆαααααααα½α #CorelDRAW To ααααααΆαα JoinSubpaths
1 275
+1
ααΆαααααααααααΎαααααΎααααα’αΆααααααααααααααΆαα
αααΎαααααΆααααααΆααααααΎααΆαααααΎαααΎαααΆαα
Size:
A4,
A3,
40*60,
50*70,
30*120,
60*120,
60*90,
60*85,
75*120,
1 275
ααΎαααΈα‘α αΎαααααααα»αααΆαααΎαααΌαααααΆααΆαα’ααααα
ααααΎα’ααααααααααααααααααααΆαααΆαααααα?
1 275
Sub RenamePagesFromTextBulk()
Dim doc As Document
Dim pg As Page
Dim shp As Shape
Dim txt As String
Dim i As Integer
Dim invalidChars As String
Dim regex As Object
If Documents.Count = 0 Then
MsgBox "ΠΠ΅Ρ ΠΎΡΠΊΡΡΡΠΎΠ³ΠΎ Π΄ΠΎΠΊΡΠΌΠ΅Π½ΡΠ°.", vbExclamation, "ΠΡΠΈΠ±ΠΊΠ°"
Exit Sub
End If
Set doc = ActiveDocument
invalidChars = "\/:*?""<>|"
Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "[\/:*?""<>|]"
regex.Global = True
For Each pg In doc.Pages
txt = ""
' ΠΠ΅ΡΠ΅ΠΊΠ»ΡΡΠ°Π΅ΠΌΡΡ Π½Π° ΡΡΡΠ°Π½ΠΈΡΡ
pg.Activate
' ΠΡΠ΅ΠΌ ΠΏΠ΅ΡΠ²ΡΠΉ ΡΠ΅ΠΊΡΡΠΎΠ²ΡΠΉ ΠΎΠ±ΡΠ΅ΠΊΡ Π½Π° ΡΡΡΠ°Π½ΠΈΡΠ΅
For i = 1 To ActivePage.Shapes.Count
Set shp = ActivePage.Shapes(i)
If shp.Type = cdrTextShape Then
txt = shp.Text.Story.Text
Exit For
End If
Next i
txt = Trim(txt)
If Len(txt) = 0 Then
' Π½Π΅Ρ ΡΠ΅ΠΊΡΡΠ° β ΠΏΡΠΎΠΏΡΡΠΊΠ°Π΅ΠΌ ΡΡΡΠ°Π½ΠΈΡΡ
GoTo NextPage
End If
' Π½ΠΎΡΠΌΠ°Π»ΠΈΠ·Π°ΡΠΈΡ ΡΠ΅ΠΊΡΡΠ°
txt = Replace(txt, vbCrLf, " ")
txt = Replace(txt, vbCr, " ")
txt = Replace(txt, vbLf, " ")
txt = regex.Replace(txt, "")
txt = Trim(txt)
If Len(txt) > 31 Then txt = Left(txt, 31)
If Len(txt) = 0 Then GoTo NextPage
' Π·Π°ΡΠΈΡΠ° ΠΎΡ Π΄ΡΠ±Π»Π΅ΠΉ
txt = MakeUniquePageName(doc, txt)
On Error Resume Next
pg.Name = txt
On Error GoTo 0
NextPage:
Next pg
MsgBox "ΠΠ΅ΡΠ΅ΠΈΠΌΠ΅Π½ΠΎΠ²Π°Π½ΠΈΠ΅ ΡΡΡΠ°Π½ΠΈΡ Π·Π°Π²Π΅ΡΡΠ΅Π½ΠΎ.", vbInformation
End Sub
Function MakeUniquePageName(doc As Document, baseName As String) As String
Dim nameTry As String
Dim counter As Integer
Dim p As Page
Dim exists As Boolean
nameTry = baseName
counter = 1
Do
exists = False
For Each p In doc.Pages
If p.Name = nameTry Then
exists = True
Exit For
End If
Next p
If Not exists Then Exit Do
nameTry = baseName & "_" & counter
counter = counter + 1
Loop
MakeUniquePageName = nameTry
End Function
1 275
αααααΆααααΆαααΆααααα αΆααααααα
ActiveDocument.Rulers.HUnits
ActiveDocument.Unit
1 275
αααα»αα±ααΆααα·ααΈαα»αααα
αΌαααααΆαααααΈαααααααΈααΆαα·ααααα
ααΆααααα»αααΆαααααααααΆα α
ααα½α α₯ αααα
α
αΆααααΈααααααΈα‘α’ ααα α‘α¦ ααααααΆ ααααΆαα’α α’α¦α
ααΉαα
αΌααααααΎααΆαααΆαααΌαααααααΈα‘α§ ααααααΆ ααααΆαα’α α’α¦ ααΆααααααΆα
ααΎααααα»αααΌααααααα’αααα’ααα»ααααΆαααααΆααααα
αααα’αα·αα·ααααΆααα’αα
αααααΆαααΆααααααΆαααΎααααα»αααααααα αα·αααααααΆααααααΆαα·α
αα
ααΆαα
ααΌαααΌαααα’αα·αα·ααααΆααα’ααα’αα ααααα½αααΆαααΆαααΆα αα·ααα½ααααα»ααααα α€αααααΆα α’αΆαα» αααα αα»α αα·α αα αααααΈααΆαααα»αααΎααααααααααααααααα
ααΎααααα»αααΌααααααΈα’ααααααα
ααααααΆαααααΎααααααααΆαααΆαααΊααααΆαααααααα ααΌαα’αααααα αα·αα’ααα»ααα»αααΆαα»αα
1 275
Sub CopyCurveLengthToText()
Dim s As Shape
Dim t As Shape
Dim lengthVal As Double
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
OrigSelection.ConvertToCurves
' Check if there is an active selection
If ActiveShape Is Nothing Then
MsgBox "Please select a curve first!", vbExclamation
Exit Sub
End If
Set s = ActiveShape
' Check if the selected shape is a curve
If s.Type = cdrCurveShape Then
' Calculate curve length (VBA default is Inches, so multiply by 2.54 for cm)
lengthVal = s.Curve.Length * 2.54
' Create Artistic Text with 4 decimal places
Set t = ActiveLayer.CreateArtisticText(0, 0, "Length: " & Round(lengthVal, 4) & " cm")
' Align text to the center of the selection
t.CenterX = s.CenterX
' Position the text slightly above the curve
t.CenterY = s.CenterY + 1
' Set text color to Red for visibility
' t.Fill.UniformColor.SetRGB 255, 0, 0
Else
MsgBox "The selected object is not a curve.", vbCritical
End If
End Sub
