Allegro导出器件坐标和转角和封装到Excel表格中

wangwil

该段代码使用了Allegro 16.6中提供的有关对Microsoft Excel支持的函数，生成的置件坐标可以直接在Excel中打开。

请将该段存为以.ils为扩展名的文件，因为它使用了嵌套的函数定义。

作为Lisp的一名忠实拥趸，我非常讨厌SKILL中使用Franz-Lisp 运算符Infix的风格；即使对于像plus这类的样的函数。

最后，欢迎拍砖或者和通过邮件和我讨论。

;; Author: willvcn
;; Email: willvcn@gmail.com
;; Last Rivised: 2014-06-06
;; This program generate a spreadsheet compoent placement report in Microsoft excel
;; XML formate, it has been tested with Allegro 16.6 and Microsoft Excel 2003.
(defun genPlacement () ; Initialize an empty spreadsheet.
  ;;procedure init the spreadsheet
  (procedure (initSpreadsheet)

(progn

   (axlSpreadsheetInit)

   ;; Define inital, default style.

   ;; Styles may be defined at any point during the spreadsheet's

   ;; construction, but must be defined before they are referenced

   ;; by any row, column, or cell.

   (axlSpreadsheetSetStyle "Default" nil)

   (axlSpreadsheetSetStyleProp "Alignment" "Vertical" "Top")

   (axlSpreadsheetSetStyleProp "Alignment" "Horizontal" "Left")

   (axlSpreadsheetSetStyleProp "Alignment" "WrapText" "1")

   ;;title cell style

   (axlSpreadsheetSetStyle "Title" "TC")

   (axlSpreadsheetSetStyleParent "Default")

   (axlSpreadsheetSetStyleBorder "Top" nil "Continuous" "2")

   (axlSpreadsheetSetStyleBorder "Bottom" nil "Continuous" "2")

   (axlSpreadsheetSetStyleProp "Font" "FontName" "Arial Unicode MS")

   (axlSpreadsheetSetStyleProp "Font" "Bold" "1")


   ;;content cell style

   (axlSpreadsheetSetStyle "Content" "CNT")

   (axlSpreadsheetSetStyleParent "Default")

   (axlSpreadsheetSetStyleBorder "Bottom" nil "Continuous" "1")

   (axlSpreadsheetSetStyleProp "Font" "FontName" "Arial Unicode MS")

   ))

  ;;procedure to save spreadsheet to disk
  (procedure (saveSpreadsheet)

(let ((tSheetFile (axlDMFileBrowse "ALLEGRO_XML" t ?title "Save placement data to")))

(progn

   ;; Write the compiled spreadsheet to XML file on disk.

   (axlSpreadsheetWrite tSheetFile)

   ;; Close and release the compiled spreadsheet's data.

   (axlSpreadsheetClose)

   )))
  ;;define a structure to hold the placement info
  (defstruct _compInfo

footprint   
    angle

y
    x

ref

)
  ;;procedure to get component infomation from a comp dbid
  (procedure (getCompInfo dbComp)

(make__compInfo

  ?ref dbComp->name

  ?x (car dbComp->symbol->xy)

  ?y (cadr dbComp->symbol->xy)

  ?angle dbComp->symbol->rotation

  ?footprint dbComp->symbol->name

  ))
  ;;procedure print out the line
  (procedure (printTitleLine totLine n)

(if (null totLine)

t

   (let ((tcell (sprintf s "%s" (car totLine))))

(progn ;(axlSpreadsheetSetColumnProp n "Width" "100")

   (axlSpreadsheetDefineCell 1 n "Title" "String" tcell)

   (printTitleLine (cdr totLine) (plus n 1))))))

  ;;get the max length of the content
  (procedure (getColumnMaxLen lColumn)

(car (sort (mapcar (lambda (s) (strlen (sprintf _s "%L" s))) lColumn) 'greaterp)))
  ;;procedure print out a content column
  (procedure (printColumn lColumn r n tFmt)

(if (null lColumn)

t

   (let ((tcell (sprintf s tFmt (car lColumn)))

(tCellFmt (if (eq tFmt "%s")

   "String"

"Number")))

(progn

   (axlSpreadsheetDefineCell r n "Content" tCellFmt tcell)

   (printColumn (cdr lColumn) (plus r 1) n tFmt)))))

  ;;procedure to print all columns
  ;;the caar of column is the header line
  ;;the lColumns is [(lColumn tFmt)]
  (procedure (printColumns lColumns n)

(if (null lColumns)

t

   (let ((lColumn (car lColumns)))

(progn

   (axlSpreadsheetSetColumnProp n "Width" (sprintf s "%n" (times 7 (getColumnMaxLen (car lColumn)))))

   (printColumn (cdr (car lColumn)) 2 n (cadr lColumn)) ;print start from row number 2

   (printColumns (cdr lColumns) (plus n 1))))))

  (let ((lCompTop (setof aComp (axlDBGetDesign)->components (not aComp->symbol->isMirrored)))

(lCompBot (setof aComp (axlDBGetDesign)->components aComp->symbol->isMirrored)))

(let ((lCompInfoTop (mapcar getCompInfo lCompTop))

  (lCompInfoBot (mapcar getCompInfo lCompBot)))

  (progn

(initSpreadsheet)

;;write the top side

(progn

  (axlSpreadsheetSetWorksheet (sprintf s "Top(%s)" (car (axlDBGetDesignUnits))))

  (printTitleLine (car lCompInfoTop)->? 1)

  (printColumns (list (list (cons "ref" lCompInfoTop~>ref) "%s")

  (list (cons "x" lCompInfoTop~>x) "%g")

  (list (cons "y" lCompInfoTop~>y) "%g")

  (list (cons "angle" lCompInfoTop~>angle) "%g")

  (list (cons "footprint" lCompInfoTop~>footprint) "%s"))

1))

;;write the bottom side

(progn

  (axlSpreadsheetSetWorksheet (sprintf s "Bot(%s)" (car (axlDBGetDesignUnits))))

  (printTitleLine (car lCompInfoBot)->? 1)

  (printColumns (list (list (cons "ref" lCompInfoBot~>ref) "%s")

  (list (cons "x" lCompInfoBot~>x) "%g")

  (list (cons "y" lCompInfoBot~>y) "%g")

  (list (cons "angle" lCompInfoBot~>angle) "%g")

  (list (cons "footprint" lCompInfoBot~>footprint) "%s"))

1))



;;write and close

(saveSpreadsheet)

))))