Reklam

* E Posta Adresiniz:
* Kodu Girin:

> 1 <
İleti Yazar
15.07.2015 18:28
81750    
ProhibiT

[80] Yetkili

Online Durumu

1469 ileti
İnşaat Mühendisi
Ankara

Kod:

;|----------------------------------------------------------------------------|
| AutoCAD çizim ekranından seçilerek belirlenen bir BLOCK altında yer alan   |
| ATTRIBUTE nesnelerinin değerleri, MS EXCEL uygulaması etkin durumda ise,   |
| bu dosyaya yeni bir çalışma sayfası eklenerek, MS EXCEL uygulaması etkin   |
| durumda değilse, yeni bir oturum açılarak, ilk çalışma sayfasına yazılır.  |
|                www.cizimokulu.com  M. Şahin Güvercin (ProhibiT) 15-07-2015 |
|____________________________________________________________________________|;
(defun c:AtEx (/ AtR Books EbL ExB ExceLApp ExCeLLs myerr n NewBook olderr PaT
               PvT rn Sheet1 Sheets sTn sTr VaL)
  (defun myerr (errmsg)
    (if (/= errmsg "\nFunction cancelled") (prompt (strcat "\n" errmsg)))
    (command "._undo" "_e") (command "._U") (setq *error* olderr) (princ))
  (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com) (princ "\n")
  (setq olderr *error* *error* myerr) (*push-error-using-command*)
  (while (not ExB) (princ "\r Attribute Export edilecek Block'u seçiniz.")
    (setq ExB (ssget ":s" (list (cons 0 "INSERT")))
          ExB (cdr (assoc 2 (entget (ssname ExB 0)))))
    (if (/= (cdr(assoc 70 (entget(tblobjname "Block" ExB)))) 2)(setq ExB nil)))
  (setq ExceLApp (vlax-get-or-create-object "Excel.Application"))
  (if (setq NewBook (vlax-get-property ExceLApp "ActiveWorkbook"))
    (setq Books  (vlax-get-property ExceLApp "Workbooks")
          Sheets (vlax-get-property NewBook "Sheets")
          Sheet1 (vlax-invoke-method Sheets "Add"))
    (setq Books   (vlax-get-property ExceLApp "Workbooks")
          NewBook (vlax-invoke-method Books "Add")
          Sheets  (vlax-get-property NewBook "Sheets")
          Sheet1  (vlax-get-property Sheets "Item" 1)))
  (setq ExCeLLs (vlax-get-property Sheet1 "Cells"))
  (vlax-put-property ExceLApp "UseSystemSeparators" :vlax-false)
  (vlax-put-property ExceLApp "DecimalSeparator" ".")
  (vlax-put-property ExceLApp "ThousandsSeparator" " ")
  (vla-put-visible ExceLApp :vlax-true)
  (setq PvT (tblobjname "Block" ExB) sTn 0 sTr 1)
  (while (setq PvT (entnext PvT))
    (if (= (cdr (assoc 0 (entget PvT))) "ATTDEF")
      (progn (setq sTn (1+ sTn)
                   AtR (append AtR (list (cdr (assoc 2 (entget PvT))))))
     (vlax-put-property ExCeLLs "Item" sTr sTn (cdr (assoc 3 (entget PvT)))))))
  (setq EbL (ssget "x" (list (cons 0 "INSERT") (cons 2 ExB))) n -1)
  (while (< (setq n (1+ n)) (sslength EbL))
    (setq sTr (1+ sTr) PvT (ssname EbL n))
    (while (= "ATTRIB" (cdr (assoc 0 (entget (setq PvT (entnext PvT))))))
      (setq PaT (cdr (assoc 2 (entget PvT))) VaL (cdr (assoc 1 (entget PvT))))
      (vlax-put-property ExCeLLs "Item" sTr (1+ (vl-position Pat AtR)) VaL)))
  (setq rn (vlax-get-property ExCeLLs "Range"
             (vlax-variant-value (vlax-get-property ExCeLLs 'Item 1 1))
             (vlax-variant-value (vlax-get-property ExCeLLs 'Item sTr sTn))))
  (vlax-invoke-method (vlax-get-property rn 'Columns) 'AutoFit)
  (vlax-invoke-method (vlax-get-property rn 'Rows) 'AutoFit)
  (vlax-put-property (vlax-get-property rn 'Borders) 'Color
    (vlax-make-variant "0.0"))
  (vlax-put-property (vlax-get-property rn 'Borders) 'LineStyle
    (vlax-make-variant "1"))
  (vlax-put-property ExcelApp "UseSystemSeparators" :vlax-true)
  (mapcar 'vlax-release-object
          (list rn ExCeLLs Sheet1 Sheets NewBook Books ExcelApp))
  (setq ExcelApp nil) (gc) (gc)
  (command "_.undo" "end") (setq *error* olderr) (*pop-error-mode*) (prin1))


Tüm dostların bayramı kutlu olsun

Where there is a will, there is a way... Beğenmek için anlamak lazım...

15.07.2015 19:40
81751    
mttlp

[5] Uzman

Online Durumu

93 ileti
Teknik Ressam
ankara

eline sağlık hocam
excell Dosyasından import etmek için nasıl yabilirim

en sevdiğim komut copy

23.07.2015 13:28
81769    
alpayelmas

[8] Kıdemli Uzman

Online Durumu

111 ileti
İnşaat Mühendisi
İstanbul

Prohibit hocam benim bu attribute ler ile ilgili bir sorum olucak müsayit olduğunuzda bir cevap yazmanız mumkun olursa cok sevınırım. daha önce paylaştıgım kalıp metraj lısplerı ve demir lisplerinde attriblerdeki tag değerlerini axcel'e aktarıp metraj formatlarını excelde duzenleyerek hakediş oluşturuyorum. Ancak autocad dosyasında ayrıca ataçmaları duzenlemek ve excel metraj sayfalarına değerler nerelerden gelmiş hazırlamak gerekiyor. Bu nedenle işlem yaptırdıgım attributelerde seçim sırasına göre bir sıra numarasına seçilmiş attrib in içine yeni bir tag ekleyip yazmak istiyorum. Bu tag değerinide attrib ile oluşturulmuş örneğin bir demir pozunda görünmesini autocad uzerınde sağlamak istiyorum.
Bunu nasıl yapabiliriz. Kısacası hocam attrib e yeni bir tag eklemek ve sıralı numara verıp autocad ekranında bu attrıbde sıra no guzuksun ıstıyorum.

23.07.2015 14:12
81770    
Travaci

[70] Editör

Online Durumu

2077 ileti
Teknik Ressam
Konstantinopol

Alpay okadarını yapabiliyorsan bunu zaten yapabileceğini düşünüyorum
Aynı isimde yeni bir block oluştur (içinde numara vericeğin tag olucak)
Projeni bu block un olduğu dosyaya taşı daha sonra block una "attsync" uygula
Attrib leri okuduğun gibi aynı şekilde yazdırıyorsun, bilmiyorsan sitede örnekler mevcut.
Gerisi zaten aynı ...

23.02.2018 17:50
86070    
onderbengu05

[2] Girişimci

Online Durumu

11 ileti

Alıntı
ProhibiT :
Kod:

;|----------------------------------------------------------------------------|
| AutoCAD çizim ekranından seçilerek belirlenen bir BLOCK altında yer alan   |
| ATTRIBUTE nesnelerinin değerleri, MS EXCEL uygulaması etkin durumda ise,   |
| bu dosyaya yeni bir çalışma sayfası eklenerek, MS EXCEL uygulaması etkin   |
| durumda değilse, yeni bir oturum açılarak, ilk çalışma sayfasına yazılır.  |
|                www.cizimokulu.com  M. Şahin Güvercin (ProhibiT) 15-07-2015 |
|____________________________________________________________________________|;
(defun c:AtEx (/ AtR Books EbL ExB ExceLApp ExCeLLs myerr n NewBook olderr PaT
               PvT rn Sheet1 Sheets sTn sTr VaL)
  (defun myerr (errmsg)
    (if (/= errmsg "\nFunction cancelled") (prompt (strcat "\n" errmsg)))
    (command "._undo" "_e") (command "._U") (setq *error* olderr) (princ))
  (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com) (princ "\n")
  (setq olderr *error* *error* myerr) (*push-error-using-command*)
  (while (not ExB) (princ "\r Attribute Export edilecek Block'u seçiniz.")
    (setq ExB (ssget ":s" (list (cons 0 "INSERT")))
          ExB (cdr (assoc 2 (entget (ssname ExB 0)))))
    (if (/= (cdr(assoc 70 (entget(tblobjname "Block" ExB)))) 2)(setq ExB nil)))
  (setq ExceLApp (vlax-get-or-create-object "Excel.Application"))
  (if (setq NewBook (vlax-get-property ExceLApp "ActiveWorkbook"))
    (setq Books  (vlax-get-property ExceLApp "Workbooks")
          Sheets (vlax-get-property NewBook "Sheets")
          Sheet1 (vlax-invoke-method Sheets "Add"))
    (setq Books   (vlax-get-property ExceLApp "Workbooks")
          NewBook (vlax-invoke-method Books "Add")
          Sheets  (vlax-get-property NewBook "Sheets")
          Sheet1  (vlax-get-property Sheets "Item" 1)))
  (setq ExCeLLs (vlax-get-property Sheet1 "Cells"))
  (vlax-put-property ExceLApp "UseSystemSeparators" :vlax-false)
  (vlax-put-property ExceLApp "DecimalSeparator" ".")
  (vlax-put-property ExceLApp "ThousandsSeparator" " ")
  (vla-put-visible ExceLApp :vlax-true)
  (setq PvT (tblobjname "Block" ExB) sTn 0 sTr 1)
  (while (setq PvT (entnext PvT))
    (if (= (cdr (assoc 0 (entget PvT))) "ATTDEF")
      (progn (setq sTn (1+ sTn)
                   AtR (append AtR (list (cdr (assoc 2 (entget PvT))))))
     (vlax-put-property ExCeLLs "Item" sTr sTn (cdr (assoc 3 (entget PvT)))))))
  (setq EbL (ssget "x" (list (cons 0 "INSERT") (cons 2 ExB))) n -1)
  (while (< (setq n (1+ n)) (sslength EbL))
    (setq sTr (1+ sTr) PvT (ssname EbL n))
    (while (= "ATTRIB" (cdr (assoc 0 (entget (setq PvT (entnext PvT))))))
      (setq PaT (cdr (assoc 2 (entget PvT))) VaL (cdr (assoc 1 (entget PvT))))
      (vlax-put-property ExCeLLs "Item" sTr (1+ (vl-position Pat AtR)) VaL)))
  (setq rn (vlax-get-property ExCeLLs "Range"
             (vlax-variant-value (vlax-get-property ExCeLLs 'Item 1 1))
             (vlax-variant-value (vlax-get-property ExCeLLs 'Item sTr sTn))))
  (vlax-invoke-method (vlax-get-property rn 'Columns) 'AutoFit)
  (vlax-invoke-method (vlax-get-property rn 'Rows) 'AutoFit)
  (vlax-put-property (vlax-get-property rn 'Borders) 'Color
    (vlax-make-variant "0.0"))
  (vlax-put-property (vlax-get-property rn 'Borders) 'LineStyle
    (vlax-make-variant "1"))
  (vlax-put-property ExcelApp "UseSystemSeparators" :vlax-true)
  (mapcar 'vlax-release-object
          (list rn ExCeLLs Sheet1 Sheets NewBook Books ExcelApp))
  (setq ExcelApp nil) (gc) (gc)
  (command "_.undo" "end") (setq *error* olderr) (*pop-error-mode*) (prin1))


Tüm dostların bayramı kutlu olsun



Şahin Hocam bu lispi çalıştıramadım yardımcı olabilir misniz?
Attribute nesneleri seçtiğimde no function definition: *PUSH-ERROR-USING-COMMAND* şeklinde bir hata veriyor.

26.04.2018 19:00
86285    
Şimşek

[2] Girişimci

Online Durumu

3 ileti
Elektrik Müh.
Ankara

Yukarıdaki lisp çalışıyor mu

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