Cephe Yazdır Makrosu ile Hızlı ve Kolay Çizim (Fast and Easy Drawing with Facade Printing Macro)

Sub Main
Dim i,obj ,j,pline,c,x,y,pline2 ,say
  with Netcad

  '------------------------------------------------------------------------------------------
'Şaban GÜL Tarafından Üretilmiştir. Telif hakkı gereği bu satırı ve alttaki satırları silmeyiniz.
'Bu Makro SagulCAD ile üretilmiştir. Daha fazla bilgi için www.sagul.net adresini ziyaret ediniz.
'İstediğiniz yenilikleri, tespit ettiğiniz hataları bize ileti gönderiniz. E-posta: sagulnet@gmail.com.
'Bu makro sadece Netcad üzerinden çalışır. 
'Makroyu çalıştırmak için Netcad Menüsünden Araçlar >> Uygulama Geliştirme >> Makro Çalıştır menüsünden makroyu çalıştırabilirsiniz.
'sagul.net/SagulCAD adresinden daha fazla bilgi edinebilirsiniz.

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

Const ForReading = 1, ForWriting = 2, ForAppending = 8

'''''' BU KODLARI GÖREBİLİYORSANIZ ÇEŞİTLİ YÖNTEMLER İLE
' BU KODLARA ULAŞTINIZ. BU KODLARIN AÇILMASI, KOPYALANMASI
' FARKLI KİŞİLERE VERİLMESİ YASAK OLUP TELİF HAKKINDA
' TABİİDİR. BU KODLARI KULLANMANIZ HUKUKİ SONUÇLAR DOĞURUR
' BU KODLARI AÇARAK ORTAYA ÇIKABİLECEK VERİ İHLALLERİNİN
' TÜM SORUMLULUĞU TARAFINIZA AİTTİR
' sabangul67@gmail.com e-posta adresine durumu anlatan
' bir eposta gönderiniz ve bu kodları bilgisayarınızdan siliniz
' aksi halde ortaya çıkabilecek tüm sorumluluğu kabul etmiş
' sayılırsınız

'Emeğe saygı göstermenizi ve lisanlı ürün kullanmanızı rica ederiz

'------------------------------------------------------------------------------------------
'--------------------------------LİSANS KONTROLÜ BAŞLANGICI -------------------------------
' Lisans kontrolü, makronun yalnızca yetkili kullanıcılar tarafından kullanılmasını sağlar
' Sistemin seri numarasını kontrol eder ve SAGULCAD lisans dosyalarıyla doğrular
'-----------------------------------------------------------------------------------------


dim BD
dim t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t10x
dim t1x,t2x,t3x,t4x

set BD = .NewBDialog("Cephe Yazdır - Sagulcad")
BD.GetCombo "ALAN_LAYER","Cephe Yazılacak Alan Tabakası:","",0
for i = 0 to .numlayers-1
    BD.AddCombo .LayerNameOf(i)
next

BD.GetString "TABAKA","Cephelerin Yazdırılacağı Tabaka:","",20
if BD.ShowModal then
   t1= BD.ValueByName("ALAN_LAYER")
   t2= BD.ValueByName("TABAKA")
   t1x= nclayermanager.layer(t1).name
   t2=""
   if t2="" then t2="SAGUL_CEPHE"
ELSE
exit sub
end if

set obj = .Newobject
set c=.Newc(0, 0, 0)
set pline2=.NewPoly
.SetFilter nothing, array(.foundlayer(t1x)),array(opline)
while .GetNextObject2(obj)
   if obj.tag=opline then
      say=say+1
      set pline=obj.getObjectAsPline()
      dim yilk,xilk,mesafe,x1,y1,mes1,mes2,aci,aci1,aci2
      yilk=pline.Cor(0).y
      xilk=pline.Cor(0).x
      dim cilk
      set cilk=.Newc(yilk,xilk,0)
      pline2.AddCoor(cilk)

      dim dic1,dic2,dic3,dic4,dic5
      Set dic1 = CreateObject("System.Collections.ArrayList")
      Set dic2 = CreateObject("System.Collections.ArrayList")
      Set dic3 = CreateObject("System.Collections.ArrayList")
      Set dic4 = CreateObject("System.Collections.ArrayList")
      Set dic5 = CreateObject("System.Collections.ArrayList")

      olcek=1
      dic1.clear
      dic2.clear
      dic3.clear
      dic4.clear
      dic5.clear

      for i=0 to pline.Num-2
         x=pline.Cor(i).x
         y=pline.Cor(i).y
         x1=pline.Cor(i+1).x
         y1=pline.Cor(i+1).y
         mes1=(x1-x)*(x1-x)
         mes2=(y1-y)*(y1-y)
         mesafe = sqr(mes1+mes2)
         aci1= y1-y
         aci2= x1-x
         dim pi,olcek,yeni1,yeni2
         pi=3.1415926535897932384626433832795
         aci= 2*atn(aci1/(aci2-mesafe))*200/pi +200
         dic1.Add mesafe
         dic2.add aci
         dic3.add y
         dic4.add x
      next

      dim msfe,acii
      dim ykory,ykorx
      ykory=yilk
      ykorx=xilk

      dim sagul
      for i=0 to pline.Num -1
         sagul=0
         x=pline.Cor(i).x
         y=pline.Cor(i).y
         dim objem ,objNum ,objCount
         with Netcad
            objCount=.NumObject
            for objNum=0 to objCount-1
               set objem=.GetObject(objNum)
               if objem.tag=opoint then
                  if round(objem.p1.y,2) =round(y,2) and round(objem.p1.x,2) =round(x,2) then
                     dic5.add objem.pname
                     sagul=sagul+1
                  else
                  end if
               end if
            next
            if sagul=0 and i<> pline.Num-1 then
               dic5.add ""
            end if
            set objem=nothing
            set objnum=nothing
         end with
      next

      dim cizgimerkezC,cizgiaci,nokad
      for i=0 to pline.Num-2
         msfe=dic1.item(i)
         acii=dic2.item(i)
         yeni1= ykory+msfe*olcek*sin(acii/200*pi)
         yeni2= ykorx+msfe*olcek*cos(acii/200*pi)
         set c=.Newc(yeni1,yeni2,0)
         pline2.AddCoor(c)

         if (ykory-yeni1)<>0 then
            cizgiaci=((yeni2-ykorx)/(yeni1-ykory))
            cizgiaci=atn(cizgiaci)
         else
            cizgiaci=1.57
         end if

         set nokad=.Newc(ykory,ykorx,0)
         set cizgimerkezC=.newc(0,0,0)
         cizgimerkezC.y=(ykory+yeni1)/2
         cizgimerkezC.x=(ykorx+yeni2)/2
         msfe=round(msfe,2)
         .addobject (.maketext(cizgimerkezC,msfe,0,0,2,cizgiaci,"7",.createlayer(t2,2)))
         ykory= yeni1
         ykorx= yeni2
      next
   end if
wend
.resetFilter
set obj=nothing
end with
End Sub