Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.681 saniye - Sorgu: 98 - Ortalama: 0.01715 saniye
 |
 |
 |
 |
|
|
|
|
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ı
|
|
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ı 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
|
|
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.
|