AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim
aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A
Forumlar > AutoLISP > bu lispte ufak yardıma ihtiyacım var.(alumina hocama selamlar :)
31.03.2015 20:44    
kaan0624
merhabalar textin ismini layer ismi yapan bi lisp yazmaya çalıştım.elimden geldiği kadarıyla yaptım fakat şöyle bir şeye ihtiyacım oldu. tıkladığım texti de o layere çevrilsin istiyorum.açıklamalı olarak yazmam gerekirse örneğin abc isimli bir textim var texte tıkladığım zaman onun değerini alıp layer ismi olarak yazıyor.ben abc yazısını da abc layerına cevirsin istiyorum.lisp kodunu aşagıda paylaşıyorum.umarım anlatabilmişimdir.yardım edebilirseniz çok sevinirim.

değerli hocalarıma saygılarımı sunuyorum.

(DEFUN C:qw ()

(setq e1 (car (entsel "\ntexte tıklayınız:")))
(redraw e1 3)

(setq lst1 (entget e1))

(setq txt1 (cdr (assoc 1 lst1)))

(setq e2(command "LAYER" "M" txt1 "C" "1" "" ""))
)

31.03.2015 22:54    
alumina
Aleykum selam Kaan. Uzun zamandir gorunmuyordun. Asagida, istedigin kodu 3 farkli sekilde yazdim. Ogrenmende faydasi olacaktır. Arsivine koy bunlari :)

Kod:

(defun c:lt1 (/ ob oc obs)
  (if (setq ob (ssget ":s" '((0 . "text"))))
   (progn
     (setq oc (getvar "cmdecho")
           obs (cdr (assoc 1 (entget (ssname ob 0)))))
      (setvar "cmdecho" 0)
    (if (not (tblsearch "layer" obs))
     (command "._layer" "_n" obs "_c" 7 "" ""))
      (command "._chprop" (ssname ob 0) "" "_la" obs "")
      (setvar "cmdecho" oc)
   )
  ) (princ)
)


(defun c:lt2 (/ ob obs)
  (if (setq ob (ssget ":s" '((0 . "text"))))
   (progn
    (setq obs (cdr (assoc 1 (entget (ssname ob 0)))))
    (if (not (tblsearch "layer" obs))
     (entmake (list (cons 0 "layer") (cons 100 "AcDbSymbolTableRecord")
              (cons 100 "AcDbLayerTableRecord") (cons 2 obs)
              (cons 62 7) (cons 70 0))))
      (vl-cmdf "._chprop" (ssname ob 0) "" "_la" obs "")
   )
  ) (princ)
)


(defun c:lt3 (/ ob dc obb obs) (vl-load-com)
  (if (setq ob (ssget ":s" '((0 . "text"))))
   (progn
    (setq dc (vla-get-activedocument (vlax-get-acad-object))
          obb (vlax-ename->vla-object (ssname ob 0))
          obs (vla-get-TextString obb))
    (if (not (tblobjname "layer" obs))
     (vla-put-color (vla-add (vla-get-layers dc) obs) 7))
      (vlax-put obb 'layer obs)
   )
  ) (princ)
)
31.03.2015 23:31    
Travaci
alumina

Bırak bunlarla uğraşmayı, sen yapıcağın şeyi biliyorsun. Kendini rahatlatmak için yazdın bunları di mi :)
Buda 4 olsun

Kod:

(defun c:lt4 (/ ss)
  (if (setq ss (ssget ":s" (list (cons 0 "text"))))
    (progn
      (if (not (tblsearch "layer" (setq ly (cdr (assoc 1
                                  (setq dt (entget (ssname ss 0))))))))
        (entmake (list (cons 0 "layer") (cons 100 "AcDbSymbolTableRecord")
          (cons 100 "AcDbLayerTableRecord") (cons 2 ly) (cons 62 1) (cons 70 0))))
      (entmod (subst (cons 8 ly) (assoc 8 dt) dt))
    )
  ) (princ)
)
31.03.2015 23:49    
alumina
Alıntı
Travaci :

cesit yazmayasin diye 3 tane yazdim ama anlasildiki 13 tanede yazsam illa da bir cesit yapacaksın :)

01.04.2015 07:30    
kaan0624
çok saolun hocam teşekkür ediiyorum.sizleri takibe devam ediyorum hocam her zaman olduğu gibi :))

> 1 <
Copyright © 2004-2022 SQL: 0.951 saniye - Sorgu: 57 - Ortalama: 0.01668 saniye