14.08.2014 14:04    

CAN123
Travaci merhaba,

Textin başındaki adetleri toplayıp aşağıdaki gibi M'den sonraki textlere göre gruplayıp yazdırmasını istiyorum.

Örnek textler:
1M16x45
3M16x45
2M16x50
1M16x50
4M16x40
3M16x40

olmasını istediğim format:

4M16x45
3M16x50
7M16x40


teşekkür ederim.

20.08.2014 05:56    

Travaci
CAN123



Kod:

(defun c:mtr (/ *error* sl s pn tx ls n tp et) (vl-load-com)
  (defun *error* (et) (command "_.undo" "e") (command "_.u")
                      (setvar "cmdecho" 1) (princ et))
  (setvar "cmdecho" 0) (command "_.undo" "be")
  (setq n -1 s -1 sl (ssget (list (cons 0 "text"))))     
  (if sl (progn
    (if (setq pn (getpoint "\nMetraj yazilacak nokta:"))
      (progn
      (while (< (setq s (1+ s)) (sslength sl))
        (setq tx (cdr (assoc 1 (entget (ssname sl s))))
              ls (append ls (list (substr tx
                 (+ 1 (vl-string-position (ascii "M") tx)))))))
      (while (< (setq n (1+ n)) (length ls))
        (setq ls (append (list (nth n ls)) (vl-remove (nth n ls) ls))))
      (setq ls (vl-sort ls '<) n 0 s 0 tp 0)
      (repeat (length ls)
        (while (< s (sslength sl))
          (setq tx (cdr (assoc 1 (entget (ssname sl s)))))
          (if (= (nth n ls)
                 (substr tx (+ 1 (vl-string-position (ascii "M") tx))))
            (progn (entdel (ssname sl s))
              (setq tp (+ tp (atof (substr tx 1
                       (vl-string-position (ascii "M") tx))))   
                    sl (ssdel (ssname sl s) sl) s (1- s))))
          (setq s (1+ s)))
       (entmake (list (cons 0 "text") (cons 10 pn) (cons 11 pn)
         (cons 40 (getvar "textsize")) (cons 72 2) (cons 73 0)
         (cons 1 (strcat (rtos tp 2 0) (nth n ls)))))
       (setq n (1+ n) s 0 tp 0
            pn (polar pn 4.71239 (* 2 (getvar "textsize")))))))))
  (command "._undo" "e") (setvar "cmdecho" 1) (princ)
)

Travaci (21.08.2014 08:47 GMT)

20.08.2014 06:13    

CAN123
Travaci merhaba,

çok teşekkür ederim.

ellerine sağlık

22.08.2014 08:53    

Travaci
CAN123


Buda çeşit olsun :D

Kod:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; 1M16x45 Gibi Civata Etiketlerinin Metrajını Yapar ;;;;;;;;
;;;;;;;;       Hazırlayan: Erkan Travaci 22.08.2014        ;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:mtr (/ *error* sl s pn tx ls n tp nn gr) (vl-load-com)
  (defun *error* (et) (command "_.undo" "e") (command "_.u")
    (setvar "cmdecho" 1))
  (setvar "cmdecho" 0) (command "_.undo" "be")
  (setq n -1 s -1 pn '(0.0 0.0 0.0) gr (ssadd)
    sl (ssget (list (cons 0 "text"))))     
  (if sl
    (progn
      (while (< (setq s (1+ s)) (sslength sl))
        (if (vl-string-search "M"
          (setq tx (cdr (assoc 1 (entget (ssname sl s))))))
          (setq ls (append ls (list (substr tx
            (+ 1 (vl-string-position (ascii "M") tx))))))))
      (while (< (setq n (1+ n)) (length ls))
        (setq ls (append (list (nth n ls)) (vl-remove (nth n ls) ls))))
      (setq ls (vl-sort ls '<) n -1 s 0 tp 0)
      (repeat (length ls) (setq n (1+ n) s 0 tp 0
        pn (polar pn 4.71239 (* 2 (getvar "textsize"))))   
        (while (< s (sslength sl))
          (if (vl-string-search "M"
            (setq tx (cdr (assoc 1 (entget (ssname sl s))))))  
            (if (= (nth n ls) (substr tx
              (+ 1 (vl-string-position (ascii "M") tx))))
              (progn (entdel (ssname sl s))
                (setq tp (+ tp (atof (substr tx 1
                  (vl-string-position (ascii "M") tx))))   
                  sl (ssdel (ssname sl s) sl) s (1- s)))))
        (setq s (1+ s)))
      (entmake (list (cons 0 "text") (cons 10 pn) (cons 11 pn)
        (cons 40 (getvar "textsize")) (cons 72 2) (cons 73 0)
        (cons 1 (strcat (rtos tp 2 0) (nth n ls))))) (ssadd (entlast) gr))
      (while (/= 3 (car (setq nn (grread T 14 0))))
        (setq nn (trans (cadr nn) 1 0 nil) n -1)
        (while (< (setq n (1+ n)) (sslength gr))
          (vla-transformby (vlax-ename->vla-object (ssname gr n))
          (vlax-tmatrix
            (list (list 1 0 0 (- (car nn) (car pn)))
            (list 0 1 0 (- (cadr nn) (cadr pn)))
            (list 0 0 1 (- (caddr nn) (caddr pn))) (list 0 0 0 1)))))
        (setq pn nn))))
  (command "._undo" "e") (setvar "cmdecho" 1) (princ))

22.08.2014 14:33    

CAN123
çok teşekkür ederim,

ellerine sağlık, sonuncusu süper oldu.

25.08.2014 10:34    

kerem1453
s.a. herkese bir çizimde 5x35[10/10 yazısını öndeki çarpım sayıları değişkenlik gösteriyor tabiki 5 ile 35 i çarpıp 175[10/10 şekline getircek bir lispe ihtiyacım var.yardımcı olcak herkese tşkler.

25.08.2014 10:37    

fruion
Merhaba Arkadaşlar,

onlarca dwg dosyasında aynı yazıyı değiştirmek istiyorum. Lakin bu çok fazla zaman alıyor. Dwg leri açmadan tek bir dwg üzerinden bir nevi find-replace sistemi yapılabilir mi acaba? Yardımcı olabilir misiniz?

Saygılarımla.

27.08.2014 21:00    

waytooraider
Merhabalar

Delta X=0 olan line ları layerına göre seçebilen bir lisp'i olan varsa paylaşabilir mi.Sitede aradım bulamadım ama kesin böyle bir lisp vardır :)

28.08.2014 06:29    

ehya
waytooraider




Delta X = 0 dediğin çizginin açısı 90 yada 270 olan çizgilerdir. Bu çizgileri quickselect ile süzgeçten geçirip seçebilirsin.

29.08.2014 05:41    

waytooraider
Çok teşekkürler hocam.Delta x=0 a göre quick select komutunu kullandım ama istediğim seçimi yapmadı.Açıya göre seçince oldu.

01.09.2014 07:03    

volkan_25
(defun c:LC (/ enlay entlst ename olderr selset enum objlen dent layent
layset lay pt1 pt2 ss ss1 ss2 en osm)

(if (null myerr)(load "myerr"))
(setq olderr *error* *error* myerr)
(setq osm (getvar "osmode"))
(if (null setvars)(load "setvars"))
(setq syslst (setvars '(("cmdecho" . 0)
("osmode" . 0)
("trimmode" . 1))
)
)
(gc)

(setq dent(list(entsel"\nPICK AN ENTITY ON THE LAYER YOU WISH COPYED: ")))
(setq dent(caar dent))
(setq layent(entget dent))
(setq layset(assoc 8 layent))
(setq lay(cdr layset))
(prompt "\n")
(princ lay)
(setq pt1 (getpoint
"\n1ST POINT OF COPY WINDOW..."))
(SETQ PT2 (GETCORNER PT1
"\n....2ND POINT "))
; (PROMPT "\n<A>DD OR <R>EMOVE OBJECTS:\n")
(COMMAND "SELECT" "C" PT1 PT2 PAUSE)
(SETQ SS (SSGET "P"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq objlen(sslength SS))
(setq enum 0)
(setq selset(ssadd))
(repeat objlen
(setq ename(ssname SS enum))
(setq entlst(entget ename))
(setq enlay(assoc 8 entlst))
(setq enlay(cdr enlay))
(if (= enlay lay)
(ssadd ename selset))
(setq enum(+ enum 1))
)
(SETQ SS selset)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(SETQ SS1 (SSGET "C" PT1 PT2))
(SETQ SS2 (SSADD))
(WHILE (SETQ EN (SSNAME SS1 0))
(IF (NULL (SSMEMB EN SS))
(SSADD EN SS2)
)
(SSDEL EN SS1)
)
(setvar "osmode" osm)
(IF (< 0 (SSLENGTH SS2))
(COMMAND "SELECT" SS2 ""
"COPY" "C" PT1 PT2 "R" "P" "")
(COMMAND "COPY" "C" PT1 PT2 "")
)
(setvars syslst)
(setq *error* olderr)
(princ)
)

(defun myerr (msg)
(if (or (= msg "quit / exit abort")
(= msg "Function cancelled"))
(if (and ctl undo_err) ; if undo_start used and returned value saved
(undo_err ctl)) ; in ctl then undo everything done so far.
(princ msg))
(if (and setvars syslst) ; if usual system var handler and variable exist
(setvars syslst)) ; then restore system vars
(setq *error* OLDERR ctl nil)
(princ)
)

(defun setvars (syslst / oldlst)
(foreach dp syslst
(setq oldlst (cons
(cons (car dp) (getvar (car dp)))
oldlst)))
(foreach dp syslst
(setvar (car dp) (cdr dp))
)
oldlst
)


(princ "\nEnter LC to COPY entities on a single layer.")
(princ)





bu lisp tek seçimle layer belirleniyor sonra bu layerlerin bulunduğu bir bölge pencere içine aldığınzda pecere içinde secilen laterdeki tüm elemanların bir kopyasını alıyor buraya kadar sorunsuz çalışıyor ama istediğim bir layer yerine çoklu layer seçip kopyalaması bir türlü yapamadım lispte daha acemiyim yardımcı olabilirseniz sevinirim iyi çalışmalar .... teşekkür ederim

03.09.2014 07:38    

aslanv
ehya hocam selam. biraz araştırdım ama sanırım bu tür bir istek gelmemiş. Aşağıdaki lisp attribute sıralı numara vermek için çok güzel. Benim isteğim express menüde textlerde yaptığımız gibi bizim belirleyeceğimiz başlangıç numaralarından başlayıp örneğin 5 er 5 er, 7 şer 7 şer artması yönünde attribute lerde lisp mevcut mu? (11,3) mesela 11 den başlayıp 14, 17 şeklinde gitmesini istiyorum.

Alıntı
ehya :
Alıntı
özkan-wien :
Arkadaslar Attribute icinde belli bir "Tag" a sirayla numara veren Lisp var mi? prefix sufixli olursa tadindan yenmez.
:-)



Komut adı ATTDEG

Kod:

(defun c:attdeg ()
(if (= secim nil)
  (setq secim "Değiştir"))
  (if (= sayi nil)(setq sayi 1))
  (setq bs (getint (strcat "\nBaşlangıç sayısı: < : " (rtos sayi 2 0)" : >")))
  (if (= bs nil)(setq bs sayi))
  (setq sayi bs)
  (initget 1 "Değiştir Başa ekle Sona ekle")
  (setq islem (getkword "\nYazı değiştirme seçeneği : Değiştir / Başa ekle / Sona ekle : "))
(setq nnn nil)
(while (= nnn nil)
  (setq nes (nentsel "\nDeğişecek yazıyı seçin:"))
  (if (= nes nil)
    (progn
    (if (= (getvar "errno") 7)(setq nnn nil))
    (if (= (getvar "errno") 52)(setq nnn t)))
    (progn
      (setq ntur (cdr (assoc 0 (entget (car nes)))))
      (if (/= ntur "ATTRIB")
(progn
  (setq nnn nil)(princ "\nSeçilen nesne ATTRIB değil..."))
(progn
(setq icerik (cdr (assoc 1 (entget (car nes))))
      data (entget (car nes)))
          (if (= islem "Değiştir")(setq yyazi (rtos sayi 2 0)))
          (if (= islem "Başa")(setq yyazi (strcat (rtos sayi 2 0)icerik)))
          (if (= islem "Sona")(setq yyazi (strcat icerik (rtos sayi 2 0))))
(entmod (subst (cons 1 yyazi)(assoc 1 data)data))
(setq sayi (+ sayi 1))
(setq nnn nil)
)))))
(princ)
)


03.09.2014 07:51    

Travaci
aslanv




Linkleri görebilmek için ÜYE olmalısınız.



Lisp açıklamasına yazmamışım ama aynı zamanda harfler içinde sıralama yapar.
Başlangıç numarası için harf girmeniz yeterli.

03.09.2014 09:14    

aslanv
sayın Travaci, süper bir çalışma. teşekkürler emekleriniz için.

06.09.2014 06:53    

BLack|E
Hocam Merhaba. Şöyle düşününün. enerji nakil hatları projeleri yapıyoruz biz. köşebentler kullanılıyor direkte. biz bu projeleri autocad'de köşebentleri ayırıyoruz. autocad'de kullandığımız card adında özel bir yazılımla imalat resimlerini oluşturuyoruz. benim sıkıntım ise bu köşebentler direğin üstünde açılı duruyor, bu köşebentleri ayırırken rotate-reference ile tek tek yüzlerce köşebent çizimlerini x yönünde yere paralel çevirmek zorunda kalıyorum. Bu köşebent çizimlerini toplu halde herhangi bir noktadan referans gösterip yere paralel dönderebilir miyiz? bunun için lisp olursa size minnettar kalacağım. Bilmeniz gereken bişey köşebent çizimlerinde görünmez et kalınlığı çizgisi, malzemenin bilgisi üzerinde text olarak yazılı şekilde L40X40X4 gibi ve üzerinde Ø13.5, Ø17.5 çapında deliklerde oluyor. bu köşebent çizimleri polyline ya da block'lu değil.Örnek çizimini yollayabilirim.

06.09.2014 09:51    

CAN123
Ucs object seçeneğini kullanip kösebenti ve delikleri kopyalayarak karti yaptiğiniz resme yapistirabilirsiniz.

08.09.2014 07:28    

BLack|E
Alıntı
CAN123 :
Ucs object seçeneğini kullanip kösebenti ve delikleri kopyalayarak karti yaptiğiniz resme yapistirabilirsiniz.



O komut yetersiz. onlarca köşebent var ve üstelik her bir köşebentin açısı birbirinden farklı. ben tek komutla referans bir noktadan bütün köşebentlerin içeriğini bozmadan hepsini yere paralel rotate yapmam lazım.

08.09.2014 07:42    

Travaci
BLack|E


Köşebentleriniz blocksa yapabilirsiniz.

08.09.2014 08:39    

özkan-wien
arkadaslar bir dwg icindeki tüm layoutlar tek seferde nasil silinir? tesekkürler

08.09.2014 08:41    

Travaci
özkan-wien


Lisp istekleri bölümü :dozingoff
Windows mantığı, birincisini seçip shift e basılı tutup sonuncusu seçip right click, delete.
Yada birine right click, select all layouts, right click, delete.

Önceki Sayfa [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [15] [20] [25] [30] [35] [40] [45] [50] [55] > 56 < [60] [65] [70] [75] [80] [85] [90] [95] [100] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.829 saniye - Sorgu: 101 - Ortalama: 0.01811 saniye