* E Posta Adresiniz:
* Kodu Girin:

> 1 <
İleti Yazar
09.03.2018 22:24
86127    
rsluzn

[2] Girişimci

Online Durumu

6 ileti

Arkadaşlar bende bir lisp var bu lispte yazıları tektek seçerek veya hepsini seçerek ad veriyor.Bu lispte seçtiklerini sırasıyla yada koordinata göre sıralıyor fakat bu lisp sadece text için yapıyor ATTRİBUTE biçin değil ben ATTRİBUTE için yapan bir lisp arıyorum.


Kod:

;  C:KIRDEG - General purpose text change.

;  Always use VMON here.
(vmon)

;  Convert radians into degrees

(defun rtod (a)
   (/ (* a 180) pi)
)

;  Convert degrees into radians

(defun dtor (a)
   (* (/ a 180) pi)
)

;  Returns mid point of two points

(defun midpoint (P1 P2)
   (polar  P1 (angle P1 P2) (/ (distance P1 P2) 2.0))
)

(defun StrPos (s1 s2 / l1 l2 i n )
   (setq i 1 l1 (strlen s1) l2 (strlen s2) n 0)
   (while (<= i l2)
          (if (= (substr s2 i l1) s1)
              (setq n i i l2)
          )
          (setq i (1+ i))
   )
   (setq i n)

)

;  Converts real into string while deleting the trailing 0's

(defun rtoa (a i j / s)
   (setq s (rtos a i j))
   (if (/= (StrPos "." s) 0)
       (progn
          (while (and (> j 0) (= (substr s (strlen s) 1) "0"))
                 (setq j (1- j) s (substr s 1 (1- (strlen s))))
          )
          (if (= (substr s (strlen s) 1) ".")
              (setq s (substr s 1 (1- (strlen s))))
          )
       )
   )
   (setq s s)
)
;  Blank-fill the given string to a specified number of characters

(defun strfill (s len)
   (substr (strcat s "                              ") 1 len)
)

;  Return the value associated with a particular entity field

(defun fld (num lst)
   (cdr (assoc num lst))
)

;--------------------------------------------------------------------------
; System variable save

(defun modes (a)
   (setq MLST nil)
   (repeat (length a)
      (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
      (setq a (cdr a))
   )
)

;--------------------------------------------------------------------------
; System variable restore

(defun moder ()
   (repeat (length MLST)
      (setvar (caar MLST) (cadar MLST))
      (setq MLST (cdr MLST))
   )
)

; Save the defaults at the time of loading

(setq KTag "K"
      KInc 1)


(defun myerror(s)
   (if (/= s "Function cancelled")
       (princ (strcat "\nError: " s))
   )
   (moder)
   (setq *error* olderr)
   (princ)
)

(defun C:KIRDEG ( / test go ss chm l n e sp nss newno nk nb)

   (setq olderr *error*
         *error* myerror
   )
   (modes '("CMDECHO" "OSMODE" ))
   (setvar "CMDECHO" 0)
   (setvar "OSMODE" (+ 32))
   (setq ss (ssget))

   (if ss
     (progn
       (setq l 0 chm 0 n (sslength ss) go nil NewNo 0)
       (while (< l n)
(if (= "TEXT" (fld 0 (setq e (entget (ssname ss l)))))
   (progn
     (setq s (cdr (setq as (assoc 1 e))))
     (if (= KTag "")
(setq nk 0)
(setq nk (strpos KTag s))
     )
     (setq nb (strpos " " s))
     (if (= nb 0)
(setq nb (1+ (strlen s)))
     )
     (setq nss (substr s (1+ nk) (- nb nk 1)))
     (if (= NewNo 0)
(setq NewNo (atoi nss))
     )
     (if (null Go)
       (progn
(setq test T)
(while test
    (initget "Tag Increment Go")
    (setq Sp
       (getint
  (strcat "\nTag/Increment/Go/<Old = "
  nss
  " New = "
  (itoa NewNo)
  "> : "
  )
       )
    )
    (cond ((= Sp "Tag")
   (setq key
     (getstring
(strcat "\nNew beam tag/<" KTag "> : ")
     )
   )
   (setq KTag key)
   (if (= KTag "")
      (setq nk 0)
      (setq nk (strpos KTag s))
   )
   (setq nb (strpos " " s))
   (if (= nb 0)
      (setq nb (1+ (strlen s)))
   )
   (setq nss (substr s (1+ nk) (- nb nk 1)))
   (if (= NewNo 0)
      (setq NewNo (atoi nss))
   )
  )
  ((= Sp "Increment")
   (setq key
      (getint
(strcat
    "\nBeam no increment/<"
    (itoa KInc)
    ">: "
)
      )
   )
   (if (numberp key)
      (setq KInc key)
   )
  )
  ((= Sp "Go") (setq go 1 Test nil))
  ((= Sp nil) (setq Test nil ))
  ((numberp Sp) (setq Test nil NewNo Sp))
    )
)
       )
     )
     (setq s
(strcat KTag
(itoa NewNo)
(substr s nb (1+ (- (strlen s) nb)))
)
     )
     (setq e (subst (cons 1 s) as e))
     (entmod e)     ; Modify the TEXT entity
     (setq chm (1+ chm))
   )
)
(setq l (1+ l) NewNo (+ NewNo KInc) )
       )
     )
   )
   (princ "Changed ")      ; Print total lines changed
   (princ chm)
   (princ " text lines.")
   (terpri)
   (moder)
)



ehya (10.03.2018 09:54 GMT)

10.03.2018 10:18
86129    
ehya

[90] Yönetici

Online Durumu

3192 ileti
Teknik Ressam
Ankara

Attribute nesneleri birden fazla text nesnesine sahip olabileceği için sıralama yada yerleştirme işlemi, klasik Text nesneleri gibi sıralanması sıkıntılıdır. Neyi nereye göre sıralayacak ve yerleştirecek?

Bu tür lispler için özelden lisp yazanlarla görüşmelisiniz.

10.03.2018 17:38
86132    
Travaci

[70] Editör

Online Durumu

2086 ileti
Teknik Ressam
Konstantinopol

Teker teker numaralandırma için



Bu sayfayı ziyaret edin.

Toplu halde numaralandırma için



Özelden iletişime geçin.

> 1 <
Copyright © 2004-2018 | Tüm Hakları Saklıdır | 243 | Site haritası | İstatistikler | Hakkımızda | Kadromuz | Gizlilik | Reklam