01.02.2012 15:32    

ehya
Travaci

Kod:

;Seçilen yazıları hizza
(defun c:hz ( / obje n i hizanok10 yazinok10 hizanok11 yazinok11 ename elist yon)
(princ "\nHizalanacak Yazıları Seçiniz :")
     (setq obje (ssget '((-4 . "<OR") (0 . "TEXT") (0 . "MTEXT") (0 . "INSERT") (0 . "ATTDEF") (-4 . "OR>"))))
  (if obje
    (progn
     (setq n (sslength obje))
     (setq i 0
               hizanok10 (cdr (assoc 10 (entget (ssname obje 0))))
               hizanok11 (cdr (assoc 11 (entget (ssname obje 0))))
     )
     (initget 1 "X Y")
     (setq yon (getkword "Hizalama Yönü ( X / Y )  <Y> ?"))
     (command "undo" "begin")
     (repeat n
            (setq ename (ssname obje i)
                          elist (entget ename)
                yazinok10 (cdr (assoc 10 elist))
                yazinok11 (cdr (assoc 11 elist))
            )
            (if (= yon "Y")
                 (progn
                       (setq hizanok10 (list (car hizanok10) (cadr yazinok10))) ;;; x yönünde hizalama
                       (if yazinok11 (setq hizanok11 (list (car hizanok11) (cadr yazinok11))))
                 )
                 (progn
                       (setq hizanok10 (list (car yazinok10) (cadr hizanok10))) ;;; y yönünde hizalama
                       (if yazinok11 (setq hizanok11 (list (car yazinok11) (cadr hizanok11))))
                 )
            );_if
            (setq elist  (subst  (cons 10 hizanok10) (assoc 10 elist) elist))
            (if yazinok11 (setq elist  (subst  (cons 11 hizanok11) (assoc 11 elist) elist)))
            (entmod elist)
            (setq i (+ i 1))
      );repeat
     (command "undo" "end")
     (princ (strcat "\n" (itoa i) " TEXT hizalandı."))
     (princ)
  ));_if & progn
);defun

ehya (02.02.2012 10:57 GMT)

02.02.2012 08:52    

Travaci
Ehya teşekkür ederim

02.02.2012 08:56    

ehya
Kodlamayı güncelledim. Tekrar alabilirsin.

02.02.2012 10:11    

Travaci
Default u kaldırabilirmiyiz ? illede birşey sorsun istiyorum.

02.02.2012 10:57    

ehya
Kalksın bakalım :)
Güncelledim. Tekrar alabilirsin.

02.02.2012 11:33    

Travaci
TEşekkür.

03.02.2012 12:40    

Travaci
Yaptığım işleme layer eklemek istiyorum.İçinde
Color,Linetype,Lineweight,plotstyle,plot olucak
İşlem bittikten sonrada işleme başlamadan önceki current layer a dönücek.
(defun c:XX()(command "XLINE" "H" )(princ))

Teşekkürler.

Travaci (03.02.2012 13:26 GMT)

03.02.2012 13:47    

ehya
Travaci






Kod:

(vl-load-com)
(setq lay (getstring "\nLayer adı:"))
(setq ara (tblsearch "layer" lay))
(if (/= ara nil)
  (progn
    (princ "\nBu layer var..."))
  (progn
    (setq acadobject (vlax-get-Acad-Object))
    (setq activedocument (vla-get-activedocument acadobject))       
    (setq Layertablosu (vla-get-layers activedocument))
    (setq layerolustur (vla-add Layertablosu lay))
       (vla-put-color layerolustur 1)                ;; layer rengi
       (vla-put-linetype layerolustur "Continuous")  ;; çizgi tipi
       (vla-put-lock layerolustur :vlax-false)       ;; lock/unlock durumu
       (vla-put-Layeron layerolustur :vlax-true)     ;; on/off durumu
       (vla-put-Freeze layerolustur :vlax-false)     ;; freeze durumu
               (vla-put-Lineweight layerolustur 30)          ;; çizgi kalınlığı
       (vla-put-Plottable layerolustur :vlax-true)   ;; baskı alınabilirlilik durumu
       (vla-put-description layerolustur "")         ;; bilgi notu
))

06.02.2012 13:24    

TR-hathor
Merhaba resimdekine benzer bir points grubu 3d haline getirmek istiyorum... bunu 3dface ile mi? yoksa pl ile dolaşıp ext vermemmi gerekiyor ve önemlisi bunu kaydırmadan dogru noktaları seçmem lazım... çok zor ve çok zaman isteyen bir iş. Lisp yardımıyla olur sanırım anca en dogrusu... internete ve formumuzda araştırdım fakat böyle bişey bulamadım, yabancı sitelerdende dilim döndügü kadar baktım fakat oralardada bişey bulamadım. Elinde bu lispten olan veya bunu yapabilen arkadaşar var mı acaba??? iyi günler.

11.02.2012 10:30    

Travaci
Aşağıdaki programda 3. noktayı belirleiğimde cızgıyi yamuk atıyor fakat duz bır lıne uzerınde yaptııgımda duzgun calısıyor, sorun nedir acaba ? birde ıkı noktayı belırledıkten sonra enter ladıgımde 3. noktayı otomatık orta nokta kendını nasıl yapabılır ?

Kod:

DEFUN C:KK2 (/)
(SETQ OL (GETVAR "DIMSCALE"))
(SETQ Nk1 (GETPOINT "\ ILK NOKTA"))
(SETQ Nk2 (GETPOINT "\ SONRAKI NOKTA"))
(SETQ mesafe ( DISTANCE NK1 NK2 ) )
(setq aci   (angle NK1 NK2))
(SETQ NK3 (POLAR NK1 (+ aci PI ) (* ol 10 )))
;(SETQ NK4 (POLAR nk2   (+ aci PI )  ( + (/ mesafe 2) (* ol 5)) ))
;(SETQ NK5 (POLAR nk4   (+ aci ( * PI 1.6 ))  ( * ol 7.3 ) ))
;(SETQ NK6 (POLAR nk5   (+ aci ( * PI 0.38 ))  ( * ol 14.6 ) ))
;(SETQ NK7 (POLAR nk6   (+ aci ( * PI 1.6 ))  ( * ol 7.3 ) ))
(SETQ NK8 (POLAR NK2 (+ aci PI ) (* ol -10 )))
(command "line" nk3 nk8  "")
(setq pt1 (getpoint "\n Yerleştirilecek Nokta.....:"))
(SETQ NK4 (POLAR pt1 (+ aci PI ) (* ol 5 )))
(SETQ NK5 (POLAR nk4   (+ aci ( * PI 1.6 ))  ( * ol 7.3 ) ))
(SETQ NK6 (POLAR nk5   (+ aci ( * PI 0.38 ))  ( * ol 14.6 ) ))
(SETQ NK7 (POLAR nk6   (+ aci ( * PI 1.6 ))  ( * ol 7.3 ) ))
(command "erase" (entlast) "")
(command "pline" nk3 nk4 nk5 nk6 nk7 nk8  "")
)

ehya (11.02.2012 15:52 GMT)

11.02.2012 11:01    

ehya
ikinci nokta gösterimi isterken getpoint komutundan sonra ilk noktanın adını yaz.

(SETQ Nk1 (GETPOINT "\ ILK NOKTA"))
(SETQ Nk2 (GETPOINT Nk1 "\ SONRAKI NOKTA"))

11.02.2012 11:19    

Travaci
Olmadı :\

11.02.2012 11:37    

ehya
sen ne yapmak istediğnii söylesen.. ona göre sağlam sağlam bir kod önersek...!!!

11.02.2012 11:41    

Travaci
Yazdığım programa baktınızmı ?
Autocad deki breakline nın aynısını yapmaya calıstım fakat komutu bıtırdıgımde kucuk bı yamukluk oluyor nedenını çözemedım
ama duz bı lıne nın ustunde yaptıgımde duzgun calısıyor.

11.02.2012 11:50    

ehya
baktım ama birşey anlamadım..

iki nokta gösteri yapıldıktan sonra buraya bir line çiziyor.
Sonra 3ncü nokta gösteriminden sonra 2nci noktayı 3'e taşıyıp 2'den 3'e tekrar bir çizgi oluşturuyor.
Nedir bu anlamadım???

11.02.2012 11:56    

Travaci
ıkı tane yaptım ıkısındede aynı sorun var asağıdakı duzgun calısıyor bundakı sorunu cozebılırsenız otekını ben yaparım bunda dedıgım daha net anlasılacaktır.

Kod:

(DEFUN C:KK1 (/)
(setq blipmode_old (getvar "blipmode"))
(setq cmdecho_old  (getvar "cmdecho" ))
(setq clayer_old   (getvar "clayer"  ))
(setq luprec_old   (getvar "luprec"  ))
(setq osmode_old   (getvar "osmode"  ))
(SETQ OL (GETVAR "DIMSCALE"))
(SETQ Nk1 (GETPOINT "\ ILK NOKTA"))
(SETQ Nk2 (GETPOINT Nk1 "\ SONRAKI NOKTA"))
(SETQ mesafe ( DISTANCE NK1 NK2 ) )
(setq aci   (angle NK1 NK2))
(SETQ NK3 (POLAR NK1 (+ aci PI ) (* ol 10 )))
(SETQ NK4 (POLAR nk2   (+ aci PI )  ( + (/ mesafe 2) (* ol 5)) ))
(SETQ NK5 (POLAR nk4   (+ aci ( * PI 1.6 ))  ( * ol 7.3 ) ))
(SETQ NK6 (POLAR nk5   (+ aci ( * PI 0.38 ))  ( * ol 14.6 ) ))
(SETQ NK7 (POLAR nk6   (+ aci ( * PI 1.6 ))  ( * ol 7.3 ) ))
(SETQ NK8 (POLAR NK2 (+ aci PI ) (* ol -10 )))
(command "pline" nk3 nk4 nk5 nk6 nk7 nk8  "")
(setvar "blipmode" blipmode_old )
(setvar "cmdecho"  cmdecho_old  )
(setvar "clayer"   clayer_old   )
(setvar "luprec"   luprec_old   )
(setvar "osmode"   osmode_old   )
)

ehya (11.02.2012 15:53 GMT)

11.02.2012 12:19    

Travaci
Uzaktan bakmış görememiş olabilirsiniz, bir line çizip 20 birim oteleyip progamı line ların endpoint inden uygularsanız anlaşılacaktır.

11.02.2012 13:43    

ehya
Kod:

(DEFUN C:KK1 (/)
(setq blipmode_old (getvar "blipmode"))
(setq cmdecho_old (getvar "cmdecho" ))
(setq clayer_old (getvar "clayer" ))
(setq luprec_old (getvar "luprec" ))
(setq osmode_old (getvar "osmode" ))
(SETQ OL (GETVAR "DIMSCALE"))
(SETQ Nk1 (GETPOINT "\nILK NOKTA"))
(SETQ Nk2 (GETPOINT Nk1 "\nSONRAKI NOKTA"))
(SETQ mesafe ( DISTANCE NK1 NK2 ) )
(setq aci (angle NK1 NK2))
(SETQ NK3 (POLAR NK1 (+ aci PI ) (* ol 10 )))
(SETQ NK4 (POLAR nk2 (+ aci PI ) ( + (/ mesafe 2) (* ol 5)) ))
(SETQ NK5 (POLAR nk4 (+ aci ( * PI 1.6 )) ( * ol 7.3 ) ))
(SETQ NK7 (POLAR nk4 aci ( * ol 10.0 ) ))
(SETQ NK8 (POLAR NK2 (+ aci PI ) (* ol -10.0 )))
(SETQ NK6 (POLAR nk7 (+ aci 1.88496) ( * ol 7.3 )))
(setvar "osmode" 0)
(command "pline" nk3 nk4 nk5 nk6 nk7 nk8 "")
(setvar "blipmode" blipmode_old )
(setvar "cmdecho" cmdecho_old )
(setvar "clayer" clayer_old )
(setvar "luprec" luprec_old )
(setvar "osmode" osmode_old )
(princ))

ehya (11.02.2012 15:51 GMT)

11.02.2012 15:36    

Travaci
Ehya ilgin için teşekkürler fakat bu yine saçmalıyor : )

11.02.2012 15:51    

ehya
Düzenledim. Tekrar alabilirsin.

Önceki Sayfa [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [15] > 17 < [20] [25] [30] [35] [40] [43] Sonraki Sayfa
Copyright © 2004-2022 SQL: 0.622 saniye - Sorgu: 99 - Ortalama: 0.00629 saniye