AutoCAD • AutoLISP • Programlama • Püfler • Komutlar • Terimler • Eğitim
aLd • TCad • FacadeCAD • Cephe Kot • HQ Library • FreeMUST • Pasdoc.A
Forumlar > AutoCAD Acil Yardım > DWG scale
04.12.2014 15:03    
raskoln
Alıntı
alumina :
peki lisp kullanmadan scale yaptiginda zaten basepoint istemiyor mu?

delinin biri kuyuya taş atmış kırk akıllı çıkaramamış gibi oldu bu konu.....
Raskoln bunu her zaman yapıyor..


sana deli diyemiyorum sen zırdelisin yoksa sen bu yazıları bakırköy deli hastanesinden mi yazıyorsun
konuyu kapatın diyorum hala dallandırıp budaklandırıyorsunuz yazık size yazık aldığınız eğitime.

09.12.2014 12:41    
özkan-wien
Raskooo senin yapmak istedigin tüm cizimleri 10 kat büyütmek degil mi?
cevabin evet ise , bana dosya yolunu yazip gönder lütfen.
C:/proje......

09.12.2014 12:45    
alumina
ozkan nasıl yapıcaksın ?

09.12.2014 12:51    
özkan-wien
yaptim bile :-) az sonra...

09.12.2014 12:54    
Travaci
Yanıtı bu olabilir mi :)


Linkleri görebilmek için ÜYE olmalısınız.
09.12.2014 12:58    
özkan-wien
yassa travaci simdiye Kadar nerdeydin.

Rasko kardesim

C ye bi klasör ac "Labor" isminde.
cizimlerini C altina bu klasöre getir "C:labor" altina
ve dwg isimlerini yaz tek tek sana zahmet
C:/labor/d1.dwg yazan yerleri doldur.
bu lispi büyüt.lsp olarak Labor klasörüne kaydet

sonra AutoCAD in icinde lispi yükleyip calistir.



(defun C:büyüt (/ dwgs scr-name lsp-name)

(setq dwgs '("C:/labor/d1.DWG" ;dwg yollarini buraya yaz
"C:/labor/d2.DWG" ;dwg yollarini buraya yaz
)
scr-name "C:/labor/tmp.scr"
lsp-name "C:/labor/büyüt.lsp"
)
(create-script scr-name dwgs lsp-name "(büyüt10)" T)
(command "_.SCRIPT" scr-name)
(vl-file-delete scr-name)
(princ)
)
(defun büyüt10 ()
(command-s "_.layer" "_thaw" "*" "")
(command-s "_.layer" "_unlock" "*" "")
(command-s "_scale" "all" "" "0,0" "10" "")
)
(defun create-script (scr dwgs lsp cmd save / f dwg)
(setq f (open scr "w"))
(foreach dwg dwgs
(progn
(write-line
(strcat "_.OPEN "" dwg """)
f
)
(write-line
(strcat "(load "" lsp "")")
f
)
(write-line cmd f)
(if save
(write-line "_.QSAVE" f)
)
(write-line "_.CLOSE" f)
)
)
(close f)
(princ)
)

09.12.2014 13:25    
alumina
elimde 100 tane dwg resmi var demişti. simdi bu 100 tane dwg isminide tek tek yazacak mi? cevabı evetse raskoln kendisinden bu kadar nefret etmen için ne yaptı :)

09.12.2014 13:27    
Travaci
özkan-wien

Daha öncede vermiştim ama ihtiyaç olmayınca kimsenin aklında kalmamış :) Artık kimsecikler unutmaz :yes
Raskoln

Şimdiden cevaplıyım, raskoln dosya isimleri için exel den yardım al ; ) Dosyaların, imalat resimleri olsa gerek, numaraları sıralıdır.

09.12.2014 13:37    
alumina
Arkadaslar doğrumu anlıyorum? bir klasör altında toplanmis cok tane dwg dosyasini tek tek acip 10 kat buyutup ayni yere farklı bir isimle kaydedip eski dosyayi siliyor.

09.12.2014 13:40    
özkan-wien
100 dosyayi copy paste yapip sonundaki rakami degistirmek < 100 x ( klasörac+dosya ac+scale+enter+ sec+enter+pick+enter+10+enter+save+enter+exit+bla bla bla....... :-))

bu lispten anlayacaginiz üzere sadece büyütme degil istenilen hersey coklu sekilde yaptirilabilir. O yüzden bu konunun daha cok kullaniciya ulasmasi ve kolay bulunmasi iicn konu adinin "coklu dwg islemeleri" ya da benzeri anlamda degismesini öneriyorum.

09.12.2014 13:44    
özkan-wien
dosya ismi degismiyo ayni dosyaya kaydediyor. icindeki herseyi 10 kat büyütüyor
istersen hepsine
(command "_.CIRCLE" "0,0,0" "10") circle da cizdirebilirsin.

09.12.2014 13:49    
alumina
iyide abi neden klasörde bulunan dwg dosya isimlerini tek tek yazdırtıyorsun adama? "c:/..." kalsorundeki butun .dwg leri acip 10 kat buyutup kaydedip kapatmayacak mı?

09.12.2014 13:51    
özkan-wien
klasörü sectirelimmi diyosun yani

09.12.2014 13:51    
alumina
15 dk bekle.. ufkunu acacagim :)

09.12.2014 13:56    
Travaci
özkan-wien

Özkan ekleme yapıcaktım ama çok üşendim valla :D
vl-directory-files ile tüm dosyaları listeyip sırayla işleme sokabilirsin. Haydi kolay gele :D
cizimokulu kalkınıyor... :yes
09.12.2014 14:11    
özkan-wien
deneme yaparken 2 dosyayla yaptik dogal olarak :-)
100 lük ve daha fazlasi icin baska yol olacak illaki

09.12.2014 14:46    
özkan-wien
Raskoo C:nin altina "Lisp" diye bi klasör ac bi zahmet.
asgidaki lispi "büyüt10.lsp" olarak C:Lisp altina kaydet.
sonra lispi yükleyip "büyüt" komutuyla cizimlerin oldugu klasörü göster. Sol tarafta acilan pencereden Dosyalarini sec ve "add files" e tikla

Kod:

                 
(defun C:büyüt(/ dwgs scr-name lsp-name)

(setq dwgs (LM:GetFiles "Select Drawings to Copy to" "" "dwg;dwt;dws"))
(setq scr-name "C:/lisp/tmp.scr"
      lsp-name "C:/lisp/büyüt10.lsp")

  (create-script scr-name dwgs lsp-name "(CreateCircle)" T)
  (command "_.SCRIPT" scr-name)
  (vl-file-delete scr-name)
  (princ)

)

(defun CreateCircle()
(command-s "_.layer" "_thaw" "*" "")
  (command-s "_.layer" "_unlock" "*" "")
(command-s "_scale" "all" "" "0,0" "10" "")


)


(defun create-script(scr dwgs lsp cmd save / f dwg)

  (setq f (open scr "w"))

  (foreach dwg dwgs

    (progn

      (write-line

        (strcat "_.OPEN "" dwg """) f
      )
      (write-line
        (strcat "(load "" lsp "")") f
      )
      (write-line cmd f)
      (if save
        (write-line "_.QSAVE" f)
      )
      (write-line "_.CLOSE" f)
    )
  )
  (close f)
  (princ)
)










(defun LM:GetFiles ( title default ext / *error* dch dcl des dir dirdata lst rtn )

    (defun *error* ( msg )
        (if (= 'file (type des))
            (close des)
        )
        (if (and (= 'int (type dch)) (< 0 dch))
            (unload_dialog dch)
        )
        (if (and (= 'str (type dcl)) (findfile dcl))
            (vl-file-delete dcl)
        )
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )   
   
    (if
        (and
            (setq dcl (vl-filename-mktemp nil nil ".dcl"))
            (setq des (open dcl "w"))
            (progn
                (foreach x
                   '(
                        "lst : list_box"
                        "{"
                        "    width = 40.0;"
                        "    height = 20.0;"
                        "    fixed_width = true;"
                        "    fixed_height = true;"
                        "    alignment = centered;"
                        "    multiple_select = true;"
                        "}"
                        ""
                        "but : button"
                        "{"
                        "    width = 20.0;"
                        "    height = 1.8;"
                        "    fixed_width = true;"
                        "    fixed_height = true;"
                        "    alignment = centered;"
                        "}"
                        ""
                        "getfiles : dialog"
                        "{"
                        "    key = "title"; spacer;"
                        "    : row"
                        "    {"
                        "        alignment = centered;"
                        "        : edit_box { key = "dir"; label = "Folder:"; }"
                        "        : button"
                        "        {"
                        "            key = "brw";"
                        "            label = "Browse";"
                        "            fixed_width = true;"
                        "        }"
                        "    }"
                        "    spacer;"
                        "    : row"
                        "    {"
                        "        : column"
                        "        {"
                        "            : lst { key = "box1"; }"
                        "            : but { key = "add" ; label = "Add Files"; }"
                        "        }"
                        "        : column {"
                        "            : lst { key = "box2"; }"
                        "            : but { key = "del" ; label = "Remove Files"; }"
                        "        }"
                        "    }"
                        "    spacer; ok_cancel;"
                        "}"
                    )
                    (write-line x des)
                )
                (setq des (close des))
                (< 0 (setq dch (load_dialog dcl)))
            )
            (new_dialog "getfiles" dch)
        )
        (progn
            (setq ext (LM:getfiles:str->lst (strcase ext) ";"))
            (set_tile "title" (if (= "" title) "Select Files" title))
            (set_tile "dir"
                (setq dir
                    (LM:getfiles:fixdir
                        (if (or (= "" default) (not (vl-file-directory-p (LM:getfiles:fixdir default))))
                            (getvar 'dwgprefix)
                            default
                        )
                    )
                )
            )
            (setq lst (LM:getfiles:updatefilelist dir ext nil))
            (mode_tile "add" 1)
            (mode_tile "del" 1)

            (action_tile "brw"
                (vl-prin1-to-string
                   '(if (setq tmp (LM:getfiles:browseforfolder "" nil 512))
                        (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir tmp)) ext rtn)
                              rtn (LM:getfiles:updateselected dir rtn)
                        )                             
                    )
                )
            )

            (action_tile "dir"
                (vl-prin1-to-string
                   '(if (= 1 $reason)
                        (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir (LM:getfiles:fixdir $value))) ext rtn)
                              rtn (LM:getfiles:updateselected dir rtn)
                        )
                    )
                )
            )

            (action_tile "box1"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm tmp )
                            (setq itm (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" $value ")"))))
                            (if (= 4 $reason)
                                (cond
                                    (   (equal '("..") itm)
                                        (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir (LM:getfiles:updir dir))) ext rtn)
                                              rtn (LM:getfiles:updateselected dir rtn)
                                        )
                                    )
                                    (   (and
                                            (not (vl-filename-extension (car itm)))
                                            (vl-file-directory-p (setq tmp (LM:getfiles:checkredirect (strcat dir "" (car itm)))))
                                        )
                                        (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir tmp)) ext rtn)
                                              rtn (LM:getfiles:updateselected dir rtn)
                                        )
                                    )
                                    (   (setq rtn (LM:getfiles:sort (append rtn (mapcar '(lambda ( x ) (strcat dir "" x)) itm)))
                                              rtn (LM:getfiles:updateselected dir rtn)
                                              lst (LM:getfiles:updatefilelist dir ext rtn)
                                        )
                                    )
                                )
                                (if (vl-some 'vl-filename-extension itm)
                                    (mode_tile "add" 0)
                                )
                            )
                        )
                    )
                )
            )

            (action_tile "box2"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (setq itm (mapcar '(lambda ( n ) (nth n rtn)) (read (strcat "(" $value ")"))))
                            (if (= 4 $reason)
                                (setq rtn (LM:getfiles:updateselected dir (vl-remove (car itm) rtn))
                                      lst (LM:getfiles:updatefilelist dir ext rtn)
                                )
                                (mode_tile "del" 0)
                            )
                        )
                    )
                )
            )

            (action_tile "add"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if
                                (setq itm
                                    (vl-remove-if-not 'vl-filename-extension
                                        (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" (get_tile "box1") ")")))
                                    )
                                )
                                (setq rtn (LM:getfiles:sort (append rtn (mapcar '(lambda ( x ) (strcat dir "" x)) itm)))
                                      rtn (LM:getfiles:updateselected dir rtn)
                                      lst (LM:getfiles:updatefilelist dir ext rtn)
                                )
                            )
                            (mode_tile "add" 1)
                            (mode_tile "del" 1)
                        )
                    )
                )
            )

            (action_tile "del"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if (setq itm (read (strcat "(" (get_tile "box2") ")")))
                                (setq rtn (LM:getfiles:updateselected dir (LM:getfiles:removeitems itm rtn))
                                      lst (LM:getfiles:updatefilelist dir ext rtn)
                                )
                            )
                            (mode_tile "add" 1)
                            (mode_tile "del" 1)
                        )
                    )
                )
            )
         
            (if (zerop (start_dialog))
                (setq rtn nil)
            )
        )
    )
    (*error* nil)
    rtn
)

(defun LM:getfiles:listbox ( key lst )
    (start_list key)
    (foreach x lst (add_list x))
    (end_list)
    lst
)

(defun LM:getfiles:listfiles ( dir ext lst )
    (vl-remove-if '(lambda ( x ) (member (strcat dir "" x) lst))
        (cond
            (   (cdr (assoc dir dirdata)))
            (   (cdar
                    (setq dirdata
                        (cons
                            (cons dir
                                (append
                                    (LM:getfiles:sortlist (vl-remove "." (vl-directory-files dir nil -1)))
                                    (LM:getfiles:sort
                                        (if (member ext '(("") ("*")))
                                            (vl-directory-files dir nil 1)
                                            (vl-remove-if-not
                                                (function
                                                    (lambda ( x / e )
                                                        (and
                                                            (setq e (vl-filename-extension x))
                                                            (setq e (strcase (substr e 2)))
                                                            (vl-some '(lambda ( w ) (wcmatch e w)) ext)
                                                        )
                                                    )
                                                )
                                                (vl-directory-files dir nil 1)
                                            )
                                        )
                                    )
                                )
                            )
                            dirdata
                        )
                    )
                )
            )
        )
    )
)


(defun LM:getfiles:sort ( lst )
    (apply 'append
        (mapcar 'LM:getfiles:sortlist
            (vl-sort
                (LM:getfiles:groupbyfunction lst
                    (lambda ( a b / x y )
                        (and
                            (setq x (vl-filename-extension a))
                            (setq y (vl-filename-extension b))
                            (= (strcase x) (strcase y))
                        )
                    )
                )
                (function
                    (lambda ( a b / x y )
                        (and
                            (setq x (vl-filename-extension (car a)))
                            (setq y (vl-filename-extension (car b)))
                            (< (strcase x) (strcase y))
                        )
                    )
                )
            )
        )
    )
)

(defun LM:getfiles:sortlist ( lst )
    (mapcar (function (lambda ( n ) (nth n lst)))
        (vl-sort-i (mapcar 'LM:getfiles:splitstring lst)
            (function
                (lambda ( a b / x y )
                    (while
                        (and
                            (setq x (car a))
                            (setq y (car b))
                            (= x y)
                        )
                        (setq a (cdr a)
                              b (cdr b)
                        )
                    )
                    (cond
                        (   (null x) b)
                        (   (null y) nil)
                        (   (and (numberp x) (numberp y)) (< x y))
                        (   (= "." x))
                        (   (numberp x))
                        (   (numberp y) nil)
                        (   (< x y))
                    )
                )
            )
        )
    )
)


(defun LM:getfiles:groupbyfunction ( lst fun / tmp1 tmp2 x1 )
    (if (setq x1 (car lst))
        (progn
            (foreach x2 (cdr lst)
                (if (fun x1 x2)
                    (setq tmp1 (cons x2 tmp1))
                    (setq tmp2 (cons x2 tmp2))
                )
            )
            (cons (cons x1 (reverse tmp1)) (LM:getfiles:groupbyfunction (reverse tmp2) fun))
        )
    )
)

(defun LM:getfiles:splitstring ( str )
    (
        (lambda ( l )
            (read
                (strcat "("
                    (vl-list->string
                        (apply 'append
                            (mapcar
                                (function
                                    (lambda ( a b c )
                                        (cond
                                            (   (= 92 b)
                                                (list 32 34 92 b 34 32)
                                            )
                                            (   (or (< 47 b 58)
                                                    (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                                                    (and (= 46 b) (< 47 a 58) (< 47 c 58))
                                                )
                                                (list b)
                                            )
                                            (   (list 32 34 b 34 32))
                                        )
                                    )
                                )
                                (cons nil l) l (append (cdr l) '(( )))
                            )
                        )
                    )
                    ")"
                )
            )
        )
        (vl-string->list (strcase str))
    )
)

(defun LM:getfiles:browseforfolder ( msg dir flg / err fld pth shl slf )
    (setq err
        (vl-catch-all-apply
            (function
                (lambda ( / app hwd )
                    (if (setq app (vlax-get-acad-object)
                              shl (vla-getinterfaceobject app "shell.application")
                              hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
                              fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg flg dir)
                        )
                        (setq slf (vlax-get-property fld 'self)
                              pth (vlax-get-property slf 'path)
                              pth (vl-string-right-trim "" (vl-string-translate "/" "" pth))
                        )
                    )
                )
            )
        )
    )
    (if slf (vlax-release-object slf))
    (if fld (vlax-release-object fld))
    (if shl (vlax-release-object shl))
    (if (vl-catch-all-error-p err)
        (prompt (vl-catch-all-error-message err))
        pth
    )
)

(defun LM:getfiles:full->relative ( dir path / p q )
    (setq dir (vl-string-right-trim "" dir))
    (cond
        (   (and
                (setq p (vl-string-position 58  dir))
                (setq q (vl-string-position 58 path))
                (not (eq (strcase (substr dir 1 p)) (strcase (substr path 1 q))))
            )
            path
        )
        (   (and
                (setq p (vl-string-position 92  dir))
                (setq q (vl-string-position 92 path))
                (eq (strcase (substr dir 1 p)) (strcase (substr path 1 q)))
            )
            (LM:getfiles:full->relative (substr dir (+ 2 p)) (substr path (+ 2 q)))
        )
        (   (and
                (setq q (vl-string-position 92 path))
                (eq (strcase dir) (strcase (substr path 1 q)))
            )
            (strcat "." (substr path (+ 2 q)))
        )
        (   (eq "" dir)
            path
        )
        (   (setq p (vl-string-position 92 dir))
            (LM:getfiles:full->relative (substr dir (+ 2 p)) (strcat ".." path))
        )
        (   (LM:getfiles:full->relative "" (strcat ".." path)))
    )
)

(defun LM:getfiles:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:getfiles:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)

(defun LM:getfiles:updatefilelist ( dir ext lst )
    (LM:getfiles:listbox "box1" (LM:getfiles:listfiles dir ext lst))
)

(defun LM:getfiles:updateselected ( dir lst )
    (LM:getfiles:listbox "box2" (mapcar '(lambda ( x ) (LM:getfiles:full->relative dir x)) lst))
    lst
)

(defun LM:getfiles:updir ( dir )
    (substr dir 1 (vl-string-position 92 dir nil t))
)

(defun LM:getfiles:fixdir ( dir )
    (vl-string-right-trim "" (vl-string-translate "/" "" dir))
)

(defun LM:getfiles:removeitems ( itm lst / idx )
    (setq idx -1)
    (vl-remove-if '(lambda ( x ) (member (setq idx (1+ idx)) itm)) lst)
)













     

özkan-wien (10.12.2014 07:37 GMT)

09.12.2014 16:54    
alumina
Ozkan degisik bir yoldan gittim. Butun dwg leri "c:/temp" icine at. Bos bir dwg ac ve dene.

Kod:

(defun c:alumina ()
(initget 1)
(setq sc (getreal "\nScale katsayisini giriniz:") fn (vl-directory-files (strcat "c:/temp") "*.*" 1))
(foreach fn1 fn
(if
(= (vl-filename-extension fn1) ".dwg")
(progn
(command "._erase" "all" ""
         "._purge" "_all" "" "_n"
         "._insert" (strcat "c:/temp/" fn1) '(0 0 0) 1 "" 0 ""
         "._explode" (entlast) ""
         "._layer" "_thaw" "*" ""
         "._layer" "_unlock" "*" ""
         "._scale" "all" "" "0,0" sc "")
(vl-file-delete (strcat "c:/temp/" fn1))
(vl-cmdf "._saveas" "2007(LT2007)" (strcat "c:/temp/" fn1) ""))))
(vl-cmdf "._close")
(princ))
09.12.2014 17:24    
alumina
onu soracaktim dun unuttum. burda active-x yokki. (vl-load-com) a gerek var mı?

09.12.2014 17:29    
Travaci
Yok tabi :yes Küstürdünüz raskoln u şimdi yazın durun.

Önceki Sayfa [1] > 2 < [3] [4] [5] Sonraki Sayfa
Copyright © 2004-2022 SQL: 1.714 saniye - Sorgu: 100 - Ortalama: 0.01714 saniye