🚀 Nokta Numaralarını Otomatik Yazıya Çevirin: Hızlı ve Doğru Çözüm!
Transform Point Numbers into Text Automatically: Fast and Accurate Solution!
Bu makro, Netcad ortamında nokta adı üretme (NADI) işlemini otomatikleştirir. Seçilen alan ve nokta tabakalarındaki verileri kullanarak nokta adlarını (NADI) oluşturur ve bu adları poligonların uygun konumlarına yerleştirir. Ayrıca, yazıların açısını otomatik olarak döndürerek görsel uyumluluk ve okunabilirlik sağlar. Kullanıcı dostu arayüzü ile tabaka seçimi, yazı boyutu ayarlama ve karakter silme gibi özelleştirmeler kolayca yapılır. Haritacılık, kadastro ve mühendislik projelerinde zaman kazandıran bu araç, NADI üretme sürecini hızlandırır ve profesyonel sonuçlar sunar. 🗺️
This macro automates point name generation (NADI) in the Netcad environment. It generates point names from selected area and point layers, placing them at appropriate positions within polygons. It also auto-rotates text for visual harmony and readability. With a user-friendly interface, it allows easy customization of layer selection, text size, and character removal. Ideal for mapping, cadastre, and engineering projects, this tool streamlines NADI generation, saving time and delivering professional results. 🗺️
Nasıl Çalışır (How Does It Work)
Makro, nokta adı üretme ve otomatik döndürme işlemini şu adımlarla gerçekleştirir:
- Kullanıcı Arayüzü: Makro başlatıldığında, bir diyalog kutusu açılır. Kullanıcı, alan tabakası, nokta tabakası ve yeni nokta tabakasını seçer. Yazı boyutu, karakter silme (örneğin “/” öncesi karakterler) gibi parametreler belirlenir.
- Nokta Adı Üretme (NADI): Seçilen tabakalardaki poligonlar ve noktalar analiz edilir. Nokta adları, poligonların geometrisine uygun konumlarda üretilir.
- Otomatik Döndürme: Nokta adlarının yazı açıları, poligonların eğimine göre otomatik hesaplanır ve döndürülür, böylece okunabilirlik optimize edilir.
- Çıktı: Üretilen nokta adları, belirlenen yazı boyutu ve stilinde, seçilen tabakaya kaydedilir. Yeni bir tabaka belirtilmişse, çıktılar bu tabakaya yönlendirilir.
Makro, hatalı girişleri (örneğin boş tabaka seçimi) kontrol eder ve kullanıcıyı bilgilendirir. Ölçek faktörünü dikkate alarak yazı boyutlarını optimize eder, böylece harita üzerinde tutarlı bir görünüm sağlar.
The macro performs point name generation and auto-rotation through these steps:
- User Interface: Upon running, a dialog box opens where users select the area layer, point layer, and new point layer. Parameters like text size and character removal (e.g., characters before “/”) are set.
- Point Name Generation (NADI): Polygons and points in the selected layers are analyzed, and point names are generated at suitable positions based on polygon geometry.
- Auto-Rotation: The text angle of point names is automatically calculated and rotated according to the polygon’s slope, optimizing readability.
- Output: Generated point names are saved to the specified layer with the chosen text size and style. If a new layer is specified, outputs are directed there.
The macro validates inputs (e.g., empty layer selection) and alerts the user. It optimizes text size based on the scale factor, ensuring a consistent appearance on maps.
Etiket ( Labels )
Türkçe Etiketler
Nokta Adı Üretme, NADI Üretme, Otomatik Döndürme, Haritacılık, Kadastro, Mühendislik, Netcad Makro, Nokta Adı, Otomasyon, Harita Yazılımı, Coğrafi Bilgi Sistemleri, CBS, Nokta Yerleştirme, Yazı Döndürme, Poligon Analizi, Tabaka Yönetimi, Yazı Boyutu Ayarı, Karakter Silme, Harita Optimizasyonu, Mühendislik Yazılımı, Netcad Otomasyon, Harita Düzenleme, Nokta Adı Otomasyonu, Kadastro Yazılımı, Teknik Çizim
Point Name Generation, NADI Generation, Auto-Rotation, Mapping, Cadastre, Engineering, Netcad Macro, Point Name, Automation, Mapping Software, Geographic Information Systems, GIS, Point Placement, Text Rotation, Polygon Analysis, Layer Management, Text Size Adjustment, Character Removal, Map Optimization, Engineering Software, Netcad Automation, Map Editing, Point Name Automation, Cadastre Software, Technical Drawing
📝 Netcad NVB Code
Sub Main()
Dim i,BD,alanOBJ,alanPOLY,j
with Netcad
Dim olcek
olcek= .getparam(94)/1000
dim list1,list2,list3,list4,list5
Set list1 = CreateObject("System.Collections.ArrayList")
Set list2 = CreateObject("System.Collections.ArrayList")
Set list3 = CreateObject("System.Collections.ArrayList")
Set list4 = CreateObject("System.Collections.ArrayList")
Set list5 = CreateObject("System.Collections.ArrayList")
' Kullanıcı arayüzü oluşturma
set BD = .NewBDialog("Nokta No Yazdır - Sagulcad")
BD.GetCombo "ALAN_LAYER","Alan Tabakası:","",0
for i = 0 to .numlayers-1
BD.AddCombo .LayerNameOf(i)
next
BD.GetCombo "NOKTA_LAYER","Nokta Tabakası:","",0
for i = 0 to .numlayers-1
BD.AddCombo .LayerNameOf(i)
next
BD.GetCombo "YENI","Yeni Nokta Tabakası:","SAGUL_NOKTA",0
for i = 0 to .numlayers-1
BD.AddCombo .LayerNameOf(i)
next
BD.GetString "KARAKTER_SIL","Karakter Öncesi Sil","/",50
BD.GetFloat "YAZIBOY","Yazı Boyu:",1.5,3
' BD.GetFloat "YAZIACI","Yazı Açısı:",2,3
' BD.GetFloat "YAZIGENISLIK","Yazı Genişliği:",1,3
' BD.GetCheck "ITALIK", "İtalik Yap", 0
' BD.GetCheck "ALTCIZGI", "Alt Çizgi Yap", 0
' BD.GetCheck "ARKAFON", "Arka Fon Yap", 0
dim t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t10x
if BD.ShowModal then
t1= BD.ValueByName("ALAN_LAYER")
t2= BD.ValueByName("NOKTA_LAYER")
t3= BD.ValueByName("KARAKTER_SIL")
t4= BD.ValueByName("YAZIBOY")
t5= BD.ValueByName("YAZIACI")
t6= BD.ValueByName("YAZIGENISLIK")
t7= BD.ValueByName("ITALIK")
t8= BD.ValueByName("ALTCIZGI")
t9= BD.ValueByName("ARKAFON")
t10= BD.ValueByName("YENI")
t10x = .foundlayer(t10)
if t10x <1 then
t10x= "SAGUL_NOKTA"
end if
' Giriş kontrolleri
if t1="" then
Msgbox " Alan Tabakası Girilmedi "
Exit sub
end if
if t2="" then
Msgbox " Nokta Tabakası Girilmedi "
Exit sub
end if
if t4<0.1 then t4=1.5
set alanOBJ = .newobject()
.setFilter nothing,array(),array(opline)
while .GetNextObject2(alanOBJ)
.DrawObject alanOBJ, blue
dim coklu2
Set coklu2 = alanOBJ.getObjectAsPline()
dim k1,k2,k3,k4,nok
For j = 1 to coklu2.num - 1
k1= coklu2.cor(j-1).y
k2= coklu2.cor(j-1).x
k3= coklu2.cor(j).y
k4= coklu2.cor(j).x
set nok = .NewC(0,0,0)
nok.y= k3
nok.x= k4
dim m1,m2
m1= k2/k1
m2= k4/k3
Dim Tampon
Tampon=-0.5
dim a,b
dim pt,enYakinNokta,nokta,Limit,objCizgi,ruhan
set enYakinNokta = .NewC(0,0,0)
set nokta = .NewC(0,0,0)
set Limit = .NewWorld(nok.y-(Tampon+1), nok.x-(Tampon+1), nok.y+(Tampon+1), nok.x+(Tampon+1))
set objCizgi = .NewObject()
.SetFilter Limit, array(), array(opoint)
Do
set ruhan= .GetNextObject
if ruhan is nothing then exit do
a = ruhan.p1.y
b= ruhan.p1.x
dim cor
set cor = .newc(0,0,0)
cor.y =k3-3*olcek
cor.x=k4+3*olcek
dim aci
dim dy,dx
dy= k3- k1
dx= k4-k2
if dx=0 then dx=0.005
aci=atn(dy/dx)
Dim sAngle
Dim Pi : Pi=3.14
if dy=0 then
sangle=pi*0.5
else
' Döndürme açısı hesaplama
sAngle = Atn(dx/dy)
sAngle=sAngle + pi * 0.5
if sangle> pi and sangle < 2*pi then
sangle=sangle-pi
end if
if sangle<pi and sangle>pi*0.5 then
sangle=sangle+2*pi
end if
if sangle>2*pi then sangle=sangle-pi
end if
dim semtx
semtx=aci*200/pi
if semtx <0 then cor.x = cor.x - t4*2.5
if semtx <-22.5 then cor.y = cor.y + t4*1.5
if semtx <-22.5 then cor.x = cor.x - t4*1.5
if semtx>0 and semtx <t4*2 then
cor.y = cor.y +t4*olcek
cor.x = cor.x -t4*3.5*olcek
end if
if semtx>95 and semtx <99 then
cor.y = cor.y +t4*olcek
cor.x = cor.x -t4*3.5*olcek
end if
dim tt
tt=0
dim yeniaci
if cor.x-ruhan.p1.x=0 then
yeniaci=atn((cor.y-ruhan.p1.y)/ 0.00005)
else
yeniaci=atn((cor.y-ruhan.p1.y)/ (cor.x-ruhan.p1.x) )
end if
dim ki1,ki2
ki1= cor.y-ruhan.p1.y
ki2= cor.x-ruhan.p1.x
dim msf
msf= sqr (ki1*ki1+ki2*ki2)
msf=round(msf,2)
if coklu2.InPoly(cor) then
tt=1
cor.y = ruhan.p1.y +t4*1.5*sin(yeniaci)*olcek
cor.x = ruhan.p1.x + t4*1.5*cos(yeniaci)*olcek
end if
dim k,r
if list3.count=0 then
list1.add cor.y
list2.add cor.x
list3.add ruhan.pname
list4.add sangle
end if
r=0
for k=0 to list3.count -1
if list3(k) =ruhan.pname then r=1
next
if r=0 then
list1.add cor.y
list2.add cor.x
list3.add ruhan.pname
list4.add sangle
end if
Loop
.Resetfilter
Next
wend
.Resetfilter
set alanOBJ = nothing
end if
.BackMessage
dim e
for e=0 to list1.count-1
dim cord
set cord = .newc(0,0,0)
cord.y =list1(e)
cord.x=list2(e)
dim kd2,g2,u2,xsg2,listsg2
Set listsg2 = CreateObject("System.Collections.ArrayList")
kd2= instr(list3(e),t3)
if kd2<1 then
g2=list3(e)
else
u2=split(list3(e),"/")
for each xsg2 in u2
listsg2.add xsg2
next
g2= listsg2(listsg2.count-1)
end if
dim tx
set tx=.MakeText(cord,g2 ,0,0,t4*olcek,list4(e),"M",.CreateLayer(t10x,4))
tx.cls= aci
if tt=1 then tx.renk=4
.addobject(tx)
next
end with
End Sub
' Poligon içinde yazı kontrolü ve yerleştirme fonksiyonu
function inPOLY(refOBJ,LayerIndex,refOBJIndex)
dim i,yaziOBJ,refPOLY
with netcad
set yaziOBJ = .newobject()
.setFilter refOBJ.Limits,array(),array(otext)
while .GetNextObject2(yaziOBJ)
set refPOLY = .newobject()
set refPOLY = refOBJ.GetObjectAsPline
if refPOLY.InPoly(yaziOBJ.p1) then
Dim Tampon
Tampon=3
dim a,b
dim pt,enYakinNokta,nokta,Limit,objCizgi,ruhan
set pt = yaziOBJ.p1
set enYakinNokta = .NewC(0,0,0)
set nokta = .NewC(0,0,0)
set Limit = .NewWorld(pt.y-(Tampon+1), pt.x-(Tampon+1), pt.y+(Tampon+1), pt.x+(Tampon+1))
set objCizgi = .NewObject()
.SetFilter Limit, array(), array(opoint)
Do
set ruhan= .GetNextObject
if ruhan is nothing then exit do
a = ruhan.p1.y
b= rehan.p1.x
dim mesafe,aci,dy,dx
mesafe= t4*4
dy= yaziOBJ.p1.y -a
dx= yaziOBJ.p1.x -b
if dx=0 then dx=0.005
aci=atn(dy/dx)
dim cor
set cor = .newc(0,0,0)
cor.y= yaziOBJ.p1.y + sin(aci)*t4*3.5
cor.x= yaziOBJ.p1.x + cos(aci)*t4*3.5
if aci>0 then
cor.y= yaziOBJ.p1.y +sin(1-aci)*t4*2.5 *(-1)
cor.x= yaziOBJ.p1.x+cos(1-aci)*t4*2.5*(-1)
end if
if aci=0 then cor.x= cor.x -t4*4.5
if aci=0 then cor.y= cor.y -t4*2.5
dim tx
if yaziOBJ.s = ruhan.pname then
dim kd1,g1,u1,xsgl,listsg1
Set listsg1 = CreateObject("System.Collections.ArrayList")
kd1= instr h.pname,t3)
if kd1<1 then
g1=ruhan.pname
else
u1=split(ruhan.pname,"/")
for each xsgl in u1
listsg1.add xsgl
next
g1= listsg1(listsg1.count-1)
end if
set tx=.MakeText(cor,g1 ,0,0,t4*olcek,0,"M",.CreateLayer(t10x,4))
end if
.addobject(tx)
Loop
.Resetfilter
end if
set refPOLY = nothing
wend
.Resetfilter
set yaziOBJ = nothing
end with
end functionnetcad-nokta-ad-uret-dondur
✅ Makroyu kullanmadan önce lütfen aşağıdaki uyarıları dikkatlice okuyunuz:
• Obje sayısı yüksekse işlem uzun sürebilir ve Netcad yazılımı yanıt veremez hale gelebilir.
• Bu nedenle tüm projelerinizi önceden yedeklemeniz önemle tavsiye edilir.
• Makro çalıştıktan sonra işlemi geri almak mümkün olmayabilir.
• Makrolar periyodik olarak güncellenmektedir; sayfamızı takip ederek güncel sürümleri kullanmaya özen gösteriniz.
💾 Makrolar yalnızca Netcad yazılımında çalışır ve .nps formatında sunulur. Bu format düzenlenemez; özelleştirme talepleriniz için bizimle iletişime geçebilirsiniz.
✉️ Görüş, öneri ve hata bildirimleri için: sabangul67@gmail.com
⚙️ Bu makrolar Kadastro, 2B, Orman, Kamulaştırma, Değerleme, CBS, Halihazır Harita, İmar Planı, Etüt-Proje gibi birçok alanda kullanılabilir.
🔐 Makrolar e-posta eki veya sosyal medya üzerinden paylaşılmaz. Talepte bulunmanız durumunda yalnızca e-posta adresinize bilgilendirme yapılır. Makrolar yalnızca internet sitemiz üzerinden paylaşılır.
📥 Makroları indirerek kullanım sorumluluğunu kabul etmiş sayılırsınız. Oluşabilecek tüm sorunlar kullanıcı sorumluluğundadır.
