AutoLisp 将特定行的块属性 ID 名称和块计数传递给 GetExcel 例程的 "Putcell" 命令

Question

我正在通过从 CAD 绘图中提取属性 ID 及其重复块计数（块实例）并将它们放入现有 excel 文件来创建定价 sheet。我想我有大部分需要的独立部分，但不知道如何将它们组合在一起，所以寻求帮助。

这些是我认为在我的日常工作中需要的步骤：

加载 GetExcel.lsp 函数，将 CAD 中的信息放入现有 Excel。
打开Excel写入。
从块中获取属性 ID 名称。将名称与行相关联。例如：ID 名称“A006”= 第 10 行。
获取该块的重复计数。例如：“3”。
创建一个循环（foreach？）以添加ID名称并计入相应的“Putcell”命令（通过其行号知道）。我可以有一个包含所有 200 个 ID 名称的行的 putcell 命令。
保存并关闭 Excel。

这是在附图中找到ID为“A002”、“A006”、“A009”、“A012”的块时最终结果的模型图。（哎呀。无法弄清楚如何在此处附加 CAD 文件或 excel 文件。抱歉。有人知道吗？）

我知道的：

a) 我有一定数量的属性 ID 名称（1 到 200）我会遇到，所以我知道所有可能的名称和它需要转到的行。（例如：ID“A006”在第 10 行）。

b) 我可以为每个 ID 名称准备一个 Putcell 命令以覆盖所有（1 到 200）。

我不知道的：

c) 如何将块 ID 名称与行相关联。

d) 如何找到重复的块计数并将其与块 ID 相关联 name/row。

e) 如何将 ID 名称和计数添加到按行关联的 putcell 命令，如下所示：(PutCell "B10" '("A006" 3))。 “A006”将始终与第 10 行一起使用。找到的属性 ID 名称和计数是随每个绘图而变化的变量。

来自 Get 的例程excel：Credit Terry Miller

(defun c:MyPricing ()

(defun GetExcel (ExcelFile$ SheetName$ MaxRange$ / Cnt# Column# ColumnRow@ CreateLists:
  CurRegion Data@ ExcelRange^ ExcelValue ExcelVariant^ Max_Range$ MaxColumn# MaxRow#
  Range$ Row# Sheet_Name$ Worksheet)
  ;-----------------------------------------------------------------------------
  ; CreateLists: - Creates Lists of SheetName$ up to MaxRange$ of Excel data
  ;-----------------------------------------------------------------------------
  (defun CreateLists: (Sheet_Name$ Max_Range$ / ReturnList@)
    (if Sheet_Name$
      (vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
        (if (= (vlax-get-property Worksheet "Name") Sheet_Name$)
          (vlax-invoke-method Worksheet "Activate")
        );if
      );vlax-for
    );if
    (if Max_Range$
      (progn
        (setq ColumnRow@ (ColumnRow Max_Range$))
        (setq MaxColumn# (nth 0 ColumnRow@))
        (setq MaxRow# (nth 1 ColumnRow@))
      );progn
      (progn
        (setq CurRegion (vlax-get-property (vlax-get-property
          (vlax-get-property *ExcelApp% "ActiveSheet") "Range" "A1") "CurrentRegion")
        );setq
        (setq MaxRow# (vlax-get-property (vlax-get-property CurRegion "Rows") "Count"))
        (setq MaxColumn# (vlax-get-property (vlax-get-property CurRegion "Columns") "Count"))
      );progn
    );if
    (setq Row# 1)
    (repeat MaxRow#
      (setq Data@ nil)
      (setq Column# 1)
      (repeat MaxColumn#
        (setq Range$ (strcat (Number2Alpha Column#)(itoa Row#)))
        (setq ExcelRange^ (vlax-get-property *ExcelApp% "Range" Range$))
        (setq ExcelVariant^ (vlax-get-property ExcelRange^ 'Value))
        (setq ExcelValue (vlax-variant-value ExcelVariant^))
        (setq ExcelValue
          (cond
            ((= (type ExcelValue) 'INT) (itoa ExcelValue))
            ((= (type ExcelValue) 'REAL) (rtosr ExcelValue))
            ((= (type ExcelValue) 'STR) (vl-string-trim " " ExcelValue))
            ((/= (type ExcelValue) 'STR) "")
          );cond
        );setq
        (setq Data@ (append Data@ (list ExcelValue)))
        (setq Column# (1+ Column#))
      );repeat
      (setq ReturnList@ (append ReturnList@ (list Data@)))
      (setq Row# (1+ Row#))
    );repeat
    ReturnList@
  );defun CreateLists:
  ;-----------------------------------------------------------------------------
  (if (= (type ExcelFile$) 'STR)
    (if (not (findfile ExcelFile$))
      (progn
        (alert (strcat "Excel file " ExcelFile$ " not found."))
        (exit)
      );progn
    );if
    (progn
      (alert "Excel file not specified.")
      (exit)
    );progn
  );if
  (gc)
  (if (setq *ExcelApp% (vlax-get-object "Excel.Application"))
    (progn
      (vlax-release-object *ExcelApp%)(gc)
    );progn
  );if
  (setq ExcelFile$ (findfile ExcelFile$))
  (setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
  (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)
  (setq *ExcelData@ nil)
  (if (= (type SheetName$) 'LIST)
    (progn
      (if (/= (type MaxRange$) 'LIST)
        (setq MaxRange$ (list MaxRange$))
      );if
      (setq Cnt# 0)
      (repeat (length SheetName$)
        (setq Sheet_Name$ (nth Cnt# SheetName$))
        (setq Max_Range$ (nth Cnt# MaxRange$))
        (princ (strcat "\nImporting " (vl-filename-base ExcelFile$) " - " Sheet_Name$ " data..."))(princ)
        (setq ReturnList@ (CreateLists: Sheet_Name$ Max_Range$))
        (setq *ExcelData@ (append *ExcelData@ (list ReturnList@)))
        (setq Cnt# (1+ Cnt#))
      );repeat
    );progn
    (progn
      (if SheetName$
        (progn (princ (strcat "\nImporting " (vl-filename-base ExcelFile$) " - " SheetName$ " data..."))(princ))
      );if
      (setq *ExcelData@ (CreateLists: SheetName$ MaxRange$))
    );progn
  );if
  (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
  (vlax-invoke-method *ExcelApp% 'Quit)
  (vlax-release-object *ExcelApp%)(gc)
  (setq *ExcelApp% nil)
  *ExcelData@
);defun GetExcel
;-------------------------------------------------------------------------------
; GetCell - Returns the cell value from the *ExcelData@ list
; Arguments: 1
;   Cell$ = Cell ID
; Syntax example: (GetCell "E19") = value of cell E19
;-------------------------------------------------------------------------------
(defun GetCell (Cell$ / Column# ColumnRow@ Return Row#)
  (setq ColumnRow@ (ColumnRow Cell$))
  (setq Column# (1- (nth 0 ColumnRow@)))
  (setq Row# (1- (nth 1 ColumnRow@)))
  (setq Return "")
  (if *ExcelData@
    (if (and (>= (length *ExcelData@) Row#)(>= (length (nth 0 *ExcelData@)) Column#))
      (setq Return (nth Column# (nth Row# *ExcelData@)))
    );if
  );if
  Return
);defun GetCell
;-------------------------------------------------------------------------------
; OpenExcel - Opens an Excel spreadsheet
; Arguments: 3
;   ExcelFile$ = Excel filename or nil for new spreadsheet
;   SheetName$ = Sheet name or nil for not specified
;   Visible = t for visible or nil for hidden
; Syntax examples:
; (OpenExcel "C:\Temp\Temp.xlsx" "Sheet2" t) = Opens C:\Temp\Temp.xlsx on Sheet2 as visible session
; (OpenExcel "C:\Temp\Temp.xlsx" nil nil) = Opens C:\Temp\Temp.xlsx on current sheet as hidden session
; (OpenExcel nil "Parts List" nil) =  Opens a new spreadsheet and creates a Part List sheet as hidden session
;-------------------------------------------------------------------------------
(defun OpenExcel (ExcelFile$ SheetName$ Visible / Sheet$ Sheets@ Worksheet)
  (if (= (type ExcelFile$) 'STR)
    (if (findfile ExcelFile$)
      (setq *ExcelFile$ ExcelFile$)
      (progn
        (alert (strcat "Excel file " ExcelFile$ " not found."))
        (exit)
      );progn
    );if
    (setq *ExcelFile$ "")
  );if
  (gc)
  (if (setq *ExcelApp% (vlax-get-object "Excel.Application"))
    (progn
      (vlax-release-object *ExcelApp%)(gc)
    );progn
  );if
  (setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
  (if ExcelFile$
    (if (findfile ExcelFile$)
      (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)
      (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
    );if
    (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
  );if
  (if Visible
    (vla-put-visible *ExcelApp% :vlax-true)
  );if
  (if (= (type SheetName$) 'STR)
    (progn
      (vlax-for Sheet$ (vlax-get-property *ExcelApp% "Sheets")
        (setq Sheets@ (append Sheets@ (list (vlax-get-property Sheet$ "Name"))))
      );vlax-for
      (if (member SheetName$ Sheets@)
        (vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
          (if (= (vlax-get-property Worksheet "Name") SheetName$)
            (vlax-invoke-method Worksheet "Activate")
          );if
        );vlax-for
        (vlax-put-property (vlax-invoke-method (vlax-get-property *ExcelApp% "Sheets") "Add") "Name" SheetName$)
      );if
    );progn
  );if
  (princ)
);defun OpenExcel
;-------------------------------------------------------------------------------
; PutCell - Put values into Excel cells
; Arguments: 2
;   StartCell$ = Starting Cell ID
;   Data@ = Value or list of values
; Syntax examples:
; (PutCell "A1" "PART NUMBER") = Puts PART NUMBER in cell A1
; (PutCell "B3" '("Dim" 7.5 "9.75")) = Starting with cell B3 put Dim, 7.5, and 9.75 across
;-------------------------------------------------------------------------------
(defun PutCell (StartCell$ Data@ / Cell$ Column# ExcelRange Row#)
  (if (= (type Data@) 'STR)
    (setq Data@ (list Data@))
  )
  (setq ExcelRange (vlax-get-property *ExcelApp% "Cells"))
  (if (Cell-p StartCell$)
    (setq Column# (car (ColumnRow StartCell$))
          Row# (cadr (ColumnRow StartCell$))
    );setq
    (if (vl-catch-all-error-p
          (setq Cell$ (vl-catch-all-apply 'vlax-get-property
            (list (vlax-get-property *ExcelApp% "ActiveSheet") "Range" StartCell$))
          );setq
        );vl-catch-all-error-p
        (alert (strcat "The cell ID \"" StartCell$ "\" is invalid."))
        (setq Column# (vlax-get-property Cell$ "Column")
              Row# (vlax-get-property Cell$ "Row")
        );setq
    );if
  );if
  (if (and Column# Row#)
    (foreach Item Data@
      (vlax-put-property ExcelRange "Item" Row# Column# (vl-princ-to-string Item))
      (setq Column# (1+ Column#))
    );foreach
  );if
  (princ)
);defun PutCell
;-------------------------------------------------------------------------------
; CloseExcel - Closes Excel spreadsheet
; Arguments: 1
;   ExcelFile$ = Excel saveas filename or nil to close without saving
; Syntax examples:
; (CloseExcel "C:\Temp\Temp.xlsx") = Saveas C:\Temp\Temp.xlsx and close
; (CloseExcel nil) = Close without saving
;-------------------------------------------------------------------------------
(defun CloseExcel (ExcelFile$ / Saveas)
  (if ExcelFile$
    (if (= (strcase ExcelFile$) (strcase *ExcelFile$))
      (if (findfile ExcelFile$)
        (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") "Save")
        (setq Saveas t)
      );if
      (if (findfile ExcelFile$)
        (progn
          (vl-file-delete (findfile ExcelFile$))
          (setq Saveas t)
        );progn
        (setq Saveas t)
      );if
    );if
  );if
  (if Saveas
    (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook")
      "SaveAs" ExcelFile$ -4143 "" "" :vlax-false :vlax-false nil
    );vlax-invoke-method
  );if
  (vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
  (vlax-invoke-method *ExcelApp% 'Quit)
  (vlax-release-object *ExcelApp%)(gc)
  (setq *ExcelApp% nil *ExcelFile$ nil)
  (princ)
);defun CloseExcel
;-------------------------------------------------------------------------------
; ColumnRow - Returns a list of the Column and Row number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Cell$ = Cell ID
; Syntax example: (ColumnRow "ABC987") = '(731 987)
;-------------------------------------------------------------------------------
(defun ColumnRow (Cell$ / Column$ Char$ Row#)
  (setq Column$ "")
  (while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91)
    (setq Column$ (strcat Column$ Char$)
          Cell$ (substr Cell$ 2)
    );setq
  );while
  (if (and (/= Column$ "") (numberp (setq Row# (read Cell$))))
    (list (Alpha2Number Column$) Row#)
    '(1 1);default to "A1" if there's a problem
  );if
);defun ColumnRow
;-------------------------------------------------------------------------------
; Alpha2Number - Converts Alpha string into Number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Str$ = String to convert
; Syntax example: (Alpha2Number "ABC") = 731
;-------------------------------------------------------------------------------
(defun Alpha2Number (Str$ / Num#)
  (if (= 0 (setq Num# (strlen Str$)))
    0
    (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
       (Alpha2Number (substr Str$ 2))
    );+
  );if
);defun Alpha2Number
;-------------------------------------------------------------------------------
; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"
;-------------------------------------------------------------------------------
(defun Number2Alpha (Num# / Val#)
  (if (< Num# 27)
    (chr (+ 64 Num#))
    (if (= 0 (setq Val# (rem Num# 26)))
      (strcat (Number2Alpha (1- (/ Num# 26))) "Z")
      (strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#)))
    );if
  );if
);defun Number2Alpha
;-------------------------------------------------------------------------------
; Cell-p - Evaluates if the argument Cell$ is a valid cell ID
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Cell$ = String of the cell ID to evaluate
; Syntax examples: (Cell-p "B12") = t, (Cell-p "BT") = nil
;-------------------------------------------------------------------------------
(defun Cell-p (Cell$)
  (and (= (type Cell$) 'STR)
    (or (= (strcase Cell$) "A1")
      (not (equal (ColumnRow Cell$) '(1 1)))
    );or
  );and
);defun Cell-p
;-------------------------------------------------------------------------------
; Row+n - Returns the cell ID located a number of rows from cell
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 2
;   Cell$ = Starting cell ID
;   Num# = Number of rows from cell
; Syntax examples: (Row+n "B12" 3) = "B15", (Row+n "B12" -3) = "B9"
;-------------------------------------------------------------------------------
(defun Row+n (Cell$ Num#)
  (setq Cell$ (ColumnRow Cell$))
  (strcat (Number2Alpha (car Cell$)) (itoa (max 1 (+ (cadr Cell$) Num#))))
);defun Row+n
;-------------------------------------------------------------------------------
; Column+n - Returns the cell ID located a number of columns from cell
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 2
;   Cell$ = Starting cell ID
;   Num# = Number of columns from cell
; Syntax examples: (Column+n "B12" 3) = "E12", (Column+n "B12" -1) = "A12"
;-------------------------------------------------------------------------------
(defun Column+n (Cell$ Num#)
  (setq Cell$ (ColumnRow Cell$))
  (strcat (Number2Alpha (max 1 (+ (car Cell$) Num#))) (itoa (cadr Cell$)))
);defun Column+n
;-------------------------------------------------------------------------------
; rtosr - Used to change a real number into a short real number string
; stripping off all trailing 0's.
; Arguments: 1
;   RealNum~ = Real number to convert to a short string real number
; Returns: ShortReal$ the short string real number value of the real number.
;-------------------------------------------------------------------------------
(defun rtosr (RealNum~ / DimZin# ShortReal$)
  (setq DimZin# (getvar "DIMZIN"))
  (setvar "DIMZIN" 8)
  (setq ShortReal$ (rtos RealNum~ 2 8))
  (setvar "DIMZIN" DimZin#)
  ShortReal$
);defun rtosr
;-------------------------------------------------------------------------------
(princ);End of GetExcel.lsp


(OpenExcel "C:\TEMP\MyBlock_Att_Test.xlsx" "MainSheet" nil);Open Excel file

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This is where I need help finding block info and adding to Putcell command
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;Example of putting in info from CAD to excel;;;;;
(PutCell "B10" '("A006" 3))
;;;;Example;;;;;


(CloseExcel "C:\TEMP\MyBlock_Att_Test.xlsx");Close Excel
);End MyPricing

这是我为了获取所需的块信息而查看的一些例程。

块属性 ID 名称：

这是 Lee Mac 的一个，它找到属性 ID 并保存到变量“数据”。我取出了 excel 导出部分，因为它可以由 Getexcel.lsp 例程处理。

;; Text 2 CSV  -  Lee Mac
;; Writes all Text, MText & Attribute content from all layouts and within
;; all blocks and nested blocks to a selected CSV file.

(defun c:txt2csv ( / data file )
    (cond
        (   (not
                (progn
                    (vlax-for block (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
                        (if (eq :vlax-false (vla-get-isxref block))
                            (vlax-for obj block
                                (cond
                                    (   (wcmatch (vla-get-objectname obj) "AcDb*Text")
                                        (setq data (cons (vla-get-textstring obj) data))
                                    )
                                    (   (and
                                            (eq "AcDbBlockReference" (vla-get-objectname obj))
                                            (eq :vlax-true (vla-get-hasattributes obj))
                                        )
                                        (foreach att (vlax-invoke obj 'getattributes)
                                            (setq data (cons (vla-get-textstring att) data))
                                        )
                                    )
                                )
                            )
                        )
                    )
                    data
                )
            )
            (princ "\nNo Text, MText or Attributes found.")
        )
        (   (not (setq file (getfiled "Create CSV file" "" "csv" 1)))
            (princ "\n*Cancel*")
        )
        (   (setq file (open file "w"))
            (foreach x data (write-line x file))
            (setq file (close file))
            (princ (strcat "\n" (itoa (length data)) " strings written to file."))
        )
        (   (princ "\nUnable to open CSV file for writing."))
    )
    (princ)
)
(vl-load-com) (princ)

块计数。

这是 Lee Mac 的另一篇文章，它按方块名称（但不是属性 ID）列出了计数。区块名称已经列在 spreadsheet 中 A 列下的正确行中。只需要通过Putcell命令在第B/row10列添加对应的ID名称ex：“A006”，在第C/row10列统计“3”即可。例如：(PutCell "B10" '("A006" 3))。我想我可以将块名称与块属性 ID 以及行相关联。计数将是每个真正未知的唯一变量。

(defun c:myblockcounter ( / blk idx itm lst sel )
    (if (setq sel (ssget '((0 . "INSERT"))))
        (repeat (setq idx (sslength sel))
            (setq blk (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx)))))))
            (if (setq itm (assoc blk lst))
                (setq lst (subst (cons blk (1+ (cdr itm))) itm lst))
                (setq lst (cons  (cons blk 1) lst))
            )
        )
    )
    (foreach itm lst (princ (strcat "\n" (car itm) ": " (itoa (cdr itm)))))
    (princ)
)

非常感谢任何帮助！

Answer 1

问题已由 pbejse 解决： https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/autolisp-to-pass-block-attribute-id-name-and-block-count-of-a/td-p/10545894

AutoLisp 将特定行的块属性 ID 名称和块计数传递给 GetExcel 例程的 "Putcell" 命令

AutoLisp to pass block attribute ID name and block count of a specific row to "Putcell" command for the GetExcel routine

excel

block

count

autolisp