;|
autolisp base function library
基础函数
用于定义一些全局变量和其他分类库需要使用的通用基础函数
|;

(vl-load-com)


;;;name:BF-acad-object
;;;desc:返回cad对象，参照lee-mac大神的写法，版权属于lee-mac大神
;;;arg:
;;;return:返回cad对象
;;;example:(BF-acad-object)
(defun BF-acad-object nil
	(eval (list 'defun 'BF-acad-object 'nil (vlax-get-acad-object)))
	(BF-acad-object)
)


;;;name:BF-active-document
;;;desc:返回当前活动文档对象，参照lee-mac大神的写法，版权属于lee-mac大神
;;;arg:
;;;return:返回当前活动文档对象
;;;example:(BF-active-document)
(defun BF-active-document nil 
	(eval (list 'defun 'BF-active-document 'nil (vla-get-activedocument (vlax-get-acad-object))))
	(BF-active-document)
)


;;;name:BF-model-space
;;;desc:返回模型空间对象，参照lee-mac大神的写法，版权属于lee-mac大神
;;;arg:
;;;return:返回模型空间对象
;;;example:(BF-model-space)
(defun BF-model-space nil
	(eval (list 'defun 'BF-model-space 'nil (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))))
	(BF-model-space)
)

;;;name:BF-Layers
;;;desc:返回图层集合，参照lee-mac大神的写法，版权属于lee-mac大神
;;;arg:
;;;return:返回图层集合对象
;;;example:(BF-Layers)
(defun BF-Layers nil
	(eval (list 'defun 'BF-Layers 'nil (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object)))))
	(BF-Layers)
)

;;;name:BF-LineTypes
;;;desc:返回线型集合，参照lee-mac大神的写法，版权属于lee-mac大神
;;;arg:
;;;return:返回线型集合对象
;;;example:(BF-LineTypes)
(defun BF-LineTypes nil
	(eval (list 'defun 'BF-LineTypes 'nil (vla-get-Linetypes (vla-get-activedocument (vlax-get-acad-object)))))
	(BF-LineTypes)
)
;;;name:BF-TextStyles
;;;desc:返回字体样式集合，参照lee-mac大神的写法，版权属于lee-mac大神
;;;arg:
;;;return:返回字体样式集合对象
;;;example:(BF-TextStyles)
(defun BF-TextStyles ()
		(eval (list 'defun 'BF-TextStyles 'nil (vla-get-TextStyles (vla-get-activedocument (vlax-get-acad-object)))))
	(BF-TextStyles)
)
;|
todo:
其他vlisp函数需要使用的cad对象，继续参照lee-mac大神的写法都要写出来供使用
|;


;;;name:BF-getinput
;;;desc:获取输入，结合initget和getkword函数
;;;arg:promptstr:提示字符串
;;;arg:inplist:关键字列表
;;;arg:default:默认返回关键字，如果没有为nil
;;;return:返回字符串
;;;example:(BF-getinput "请输入参数" '("Y" "N") "Y")
(defun BF-getinput (promptstr inplist default / inp) 
	(initget (if default 0 1)	(BF-lst->str inplist " ")) ;根据默认值确定initget参数
	(if (setq inp 
				(getkword 
					(strcat
						(if promptstr (strcat promptstr " [") "[") ;结合提示字符串和[]
						(BF-lst->str inplist "/") ;处理提示字符串
						"]"                  
						(if (and default (member default inplist)) ;处理默认值
							(strcat " <" default ">: ")
							": ")
					)
				)
			) 
		inp
		default
	)
);此函数未处理参数 inplist 合法性


;;;name:BF-startundo
;;;desc:开始撤销编组 -- lee mac
;;;arg:doc:当前活动文档-(BF-active-document)
;;;return:nil
;;;example:(BF-startundo (BF-active-document))
(defun BF-startundo (doc)
	(BF-endundo doc)
	(vla-startundomark doc)
)

;;;name:BF-endundo
;;;desc:结束编组 -- lee mac
;;;arg:doc:当前活动文档-(BF-active-document)
;;;return:nil
;;;example:(BF-endundo (BF-active-document))
(defun BF-endundo ( doc )
	(while (= 8 (logand 8 (getvar 'undoctl)))
		(vla-endundomark doc)
	)
)

;;;name:BF-vlap
;;;desc:判断是否vla对象?
;;;arg:obj:vla对象
;;;return:vla对象为t，其他为nil
;;;example:(BF-vlap obj1)
(defun BF-vlap (obj) (equal (type obj) 'vla-object))

;;;name:BF-stringp
;;;desc:判断是否字符串?
;;;arg:arg:字符串
;;;return:字符串为t，其他为nil
;;;example:(BF-stringp "123")
(defun BF-stringp (arg) (equal (type arg) 'str))

;;;name:BF-realp
;;;desc:判断是否实数?
;;;arg:arg:数字
;;;return:实数为t，其他为nil
;;;example:(BF-stringp 1.2)
(defun BF-realp (arg) (equal (type arg) 'real))

;;;name:BF-enamep
;;;desc:判断是否图元?
;;;arg:arg:图元名
;;;return:图元名为t，其他为nil
;;;example:(BF-enamep obj)
(defun BF-enamep (arg) (equal (type arg) 'ename))

;;;name:BF-variantp
;;;desc:判断是否变体?
;;;arg:arg:变体名
;;;return:变体名为t，其他为nil
;;;example:(BF-variantp obj)
(defun BF-variantp (arg) (equal (type arg) 'variant))

;;;name:BF-picksetp
;;;desc:判断是否非空选择集?
;;;arg:x:选择集
;;;return:非空选择集为t，其他为nil
;;;example:(BF-picksetp obj)
(defun BF-picksetp (x)
  (and (= (type x) 'pickset) (> (sslength x) 0))
)

;;;name:BF-intp
;;;desc:判断是否整数?
;;;arg:x:数字
;;;return:整数为t，其他为nil
;;;example:(BF-intp 1)
(defun BF-intp (x) (equal (type x) 'int))

;;;name:BF-safearrayp
;;;desc:判断是否为安全数组
;;;arg:x:数组
;;;return:数组为t，其他为nil
;;;example:(BF-safearrayp a)
(defun BF-safearrayp (x)
	(equal (type x) 'safearray)
)

;;;name:BF-ename-listp
;;;desc:判断是否为图元名列表
;;;arg:lst:图元名列表
;;;return:图元名列表为t，其他为nil
;;;example:(BF-ename-listp '(a b c))
(defun BF-ename-listp (lst)
	(apply 'and (mapcar 'BF-enamep lst))
)

;;;name:BF-vla-listp
;;;desc:判断是否为vla对象列表
;;;arg:lst:vla对象列表
;;;return:vla对象列表为t，其他为nil
;;;example:(BF-vla-listp '(a b c))
(defun BF-vla-listp (lst)
	(apply 'and (mapcar 'BF-vlap lst))
)

;;;name:BF-string-listp
;;;desc:判断是否为字符串列表
;;;arg:lst:字符串列表
;;;return:字符串列表为t，其他为nil
;;;example:(BF-string-listp '("a" "b" "c"))
(defun BF-string-listp (lst)
	(apply 'and (mapcar 'BF-stringp lst))
)

;;;name:BF-listp
;;;desc:判断表是否为真正的表,非nil、非点对表
;;;arg:lst:表
;;;return:表为t，其他为nil
;;;example:(BF-listp '("a" "b" "c"))
(defun BF-listp (lst)
  (and (vl-consp lst)
		(vl-list-length lst)
	)
)


;;;name:BF-DotPairp
;;;desc:是否为点对表
;;;arg:lst:点对表
;;;return:点对表为t，其他为nil
;;;example:(BF-DotPairp '("a" "b" . "c"))
(defun BF-DotPairp (lst)
  (and (vl-consp lst)
		(not (vl-list-length lst))
  )
)

;;;name:BF-curvep
;;;desc:是否是曲线
;;;arg:obj:曲线
;;;return:曲线为t，其他为nil
;;;example:(BF-curvep a)
(defun BF-curvep(obj)
  (and (member
				 (vla-get-objectname obj)
				 '("AcDbPolyline" "AcDbSpline" "AcDb3dPolyline" "AcDb2dPolyline" "AcDbLine" "AcDbCircle" "AcDbArc" "AcDbEllipse")
			 ))
)


;;;name:BF-protect-assign
;;;desc:符号保护 
;;;arg:syms:变量名列表
;;;return:
;;;example:(BF-protect-assign '(aaa bbb))
(defun BF-protect-assign (syms)
  (eval	(list 'pragma
					(list 'quote (list (cons 'protect-assign syms)))
				)
  )
)


;;;name:BF-unprotect-assign
;;;desc:符号解除保护 
;;;arg:syms:变量名列表
;;;return:
;;;example:(BF-unprotect-assign '(aaa bbb))
(defun BF-unprotect-assign	(syms)
  (eval
    (list 'pragma
			(list 'quote (list (cons 'unprotect-assign syms)))
    )
  )
)

;;;name:setconst
;;;desc:定义全局常量
;;;arg:key:全局常量名
;;;arg:value:全局常量值
;;;return:返回一个符号保护的变量
;;;example:(setconst 'aaa 2)
(defun setconst (key value)
	(setq key (vl-symbol-name key))
	(BF-unprotect-assign (list (read key)))
	(set (read key) value)
  (BF-protect-assign (list (read key)))
)


;;;name:BF-doc-gen
;;;desc:文档生成函数
;;;arg:lspfilename:要生成文档的lsp文件名，格式为getfiled返回值的格式
;;;return:生成markdown文件
;;;example:(BF-doc-gen "E:\\lisptest.lsp")
(defun BF-doc-gen (lspfilename / arg description docpath example fbasename ff filepath fpath header lines markdownfile ret subroutine)
	
	(defun header (filename)
		(write-line  (BF-str-format "# {0}\r\n" filename) markdownfile))
	
	(defun subroutine (str)
		(write-line  (BF-str-format "## {0}\r\n" str) markdownfile))
	
	(defun description (str) 
		(write-line  (BF-str-format "说明：\r\n{0}\r\n\r\n参数：\r\n" str) markdownfile))
	
	(defun arg (str)
		(setq str (BF-str->lst str ":"))
		(write-line 
			(if (> (length str) 1) 
				(BF-str-format "* {0} - {1}\r\n" str)
				"* No arguments\r\n"
			)
			markdownfile
		)
	)
	
	(defun ret (str)
		(write-line (BF-str-format "返回值: \r\n{0}\r\n" str) markdownfile)
	)
	
	(defun example (str)
		(write-line (BF-str-format "示例:\r\n```\r\n{0}\r\n ```\r\n" str) markdownfile)
	)
	
	(defun default (str)
		(write-line (BF-str-format " + {0}\r\n" str) markdownfile)
	)
	
	(defun defaultexample (str)
		(write-line (BF-str-format "```\r\n{0}\r\n ```\r\n" str) markdownfile)
	)
	
	(setq filepath (vl-filename-directory lspfilename)
		fbasename (vl-filename-base lspfilename)
		docpath (strcat filepath "\\doc\\")
	)
	(vl-mkdir docpath)
	(setq markdownfile (open (setq fpath (strcat docpath fbasename ".markdown")) "w"))
	(header (strcat (vl-filename-base lspfilename) ".lsp"))
	(setq ff (open lspfilename "r"))
	(while (setq lines (read-line ff))
		(cond 
			((wcmatch lines ";;;name:*") (subroutine (vl-string-subst "" ";;;name:" lines)))
			((wcmatch lines ";;;desc:*") (description (vl-string-subst "" ";;;desc:" lines)))
			((wcmatch lines ";;;arg:*") (arg (vl-string-subst "" ";;;arg:" lines)))
			((wcmatch lines ";;;return:*") (ret (vl-string-subst "" ";;;return:" lines)))
			((wcmatch lines ";;;example:*") (example (vl-string-subst "" ";;;example:" lines)))
			((wcmatch lines ";;;(*") (defaultexample (vl-string-subst "" ";;;" lines)))
			((wcmatch lines ";;;*") (default (vl-string-subst "" ";;;" lines)))
		)
	)
	
	(close ff)
	(close markdownfile)
	(print (strcat "生成markdown文档完毕，位置：" fpath ))
	(princ)
)

;;;name:BF-time-start
;;;desc:计时器开始函数
;;;arg:
;;;return:计时器全局变量
;;;example:(BF-time-start)
(defun BF-time-start ()
	(setq *program-used-time* (getvar "TDUSRTIMER"))
)
;;;name:BF-time-end
;;;desc:计时器结束函数
;;;arg:
;;;return:输出用时，设置计时器全局变量为nil
;;;example:(BF-time-end)
(defun BF-time-end ()
	(princ "\n函数执行用时")
  (princ (* (- (getvar "TDUSRTIMER") *program-used-time*) 86400))
  (princ "秒\n")
	(setq *program-used-time* nil)
	(princ)
)
;;;name:BF-e->vla
;;;desc:重定义vlax-ename->vla-object函数
;;;arg:ename:图元名
;;;return:vla对象
;;;example:(BF-e->vla (car (entsel)))
(defun BF-e->vla (ename)
	(vlax-ename->vla-object ename)
)
;;;name:BF-vla->e
;;;desc:重定义vlax-vla-object->ename函数
;;;arg:obj:vla对象名
;;;return:图元名
;;;example:(BF-vla->e obj)
(defun BF-vla->e (obj)
	(vlax-vla-object->ename obj)
)

;;;name:BF-save-system-variable
;;;desc:保存系统变量函数,保存当前的系统变量,为程序在非正常退出时恢复系统变量用
;;;arg:a:系统变量名组成的表(变量名  变量名 ....)
;;;return:全局变量-*user-system-variable*-系统变量及其值组成的表((变量名 . 值) (...  ...))
;;;example:(BF-save-system-variable '("cmdecho" "osmode" "dimtxt"))
(defun BF-save-system-variable (a)
	(setq *user-system-variable* (mapcar 'cons a (mapcar 'getvar a))) 
)

;;;name:BF-reset-system-variable
;;;desc:恢复系统变量函数，和BF-save-system-variable成对使用
;;;arg:
;;;return:nil
;;;example:(BF-reset-system-variable)
(defun BF-reset-system-variable ()
	(mapcar 'setvar (mapcar 'car *user-system-variable*) (mapcar 'cdr *user-system-variable*))
	(setq *user-system-variable* nil)
)
;;;name:BF-return
;;;desc:返回值函数，用于包装将要返回的值，主要作用还是为了含义更明确。
;;;arg:value:需要返回的值
;;;return:返回值
;;;example:(BF-return 1)
(defun BF-return (value) value)

;;;name:BF-AddSupportPath
;;;desc:添加支持文件搜索路径，将路径添加到最后
;;;arg:lst:要添加的路径列表
;;;return:支持文件搜索路径字符串=ACAD环境变量值
;;;example:(BF-AddSupportPath '("C:\\Folder1" "C:\\Folder2" "C:\\Folder3"))
(defun BF-AddSupportPath (lst)
	((lambda (str lst)
		 (if (setq lst
					 (vl-remove-if
						 '(lambda ( x )
								(or (vl-string-search (strcase x) (strcase str))
									(not (findfile x))
								)
							)
						 lst
					 )
				 )
			 (setenv "ACAD" (strcat str ";" (apply 'strcat (mapcar '(lambda (x) (strcat x ";")) lst))))
		 )
	 )
		(vl-string-right-trim ";" (getenv "ACAD"))
		(mapcar '(lambda (x) (vl-string-right-trim "\\" (vl-string-translate "/" "\\" x))) lst)
	)
)
;;;name:BF-RemoveSupportPath
;;;desc:删除支持文件搜索路径
;;;arg:lst:要删除的路径列表
;;;return:支持文件搜索路径字符串=ACAD环境变量值
;;;example:(BF-RemoveSupportPath '("C:\\Folder1" "C:\\Folder2" "C:\\Folder3"))
(defun BF-RemoveSupportPath (lst / del str tmp)
	
	(defun del (old str / pos)
		(if (setq pos (vl-string-search (strcase old) (strcase str)))
			(strcat (substr str 1 pos) (del old (substr str (+ 1 pos (strlen old)))))
			str
		)
	)   
	(setq str (strcat (vl-string-right-trim ";" (getenv "ACAD")) ";")
		tmp str
	)
	(foreach pth lst
		(setq str (del (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth)) ";") str))
	)
	(if (/= tmp str) (setenv "ACAD" str))
)


;;;name:BF-CatchApply
;;;desc:重定义 VL-CATCH-ALL-APPLY ，Gu_xl
;;;arg:fun:函数 如 distance or 'distance
;;;arg:args:函数的参数表
;;;return:如函数运行错误返回nil,否则返回函数的返回值
;;;example:(BF-CatchApply '+ '(1 2 3 4))
(defun BF-CatchApply (fun args / result)
  (if
    (not
      (vl-catch-all-error-p
				(setq result
					(vl-catch-all-apply
						(if (= 'SYM (type fun))
							fun
							(function fun)
						)
						args
					)
				)
      )
    )
		result
  )
)


;;;name:BF-RemoveMenuItem
;;;desc:移除下拉菜单，Gu_xl 
;;;arg:POPName:下拉菜单名称
;;;return:成功返回T，反之nil
;;;example:(BF-RemoveMenuItem "CASS工具");移除 “CASS工具” 菜单
(defun BF-RemoveMenuItem (POPName / menubar menuitem)
  (setq MenuBar (vla-get-menubar (vlax-get-acad-object)))
  ;; 找菜单 Item 
  (setq menuitem (BF-CatchApply 'vla-item (list MenuBar POPName)))
  (if menuitem (BF-CatchApply 'vla-RemoveFromMenuBar (list menuitem)))
)

;;;name:BF-AddMenu
;;;desc:添加下拉菜单，Gu_xl
;;;arg:MenuGroupName:要插入的菜单组名称
;;;arg:POPName:下拉菜单名称
;;;arg:PopItems:下拉菜单列表，如 '((标签 命令 帮助字串 次级子项)...) 表为下拉菜单列表，注意命令后要有一个空格
;;;arg:InsertBeforeItem:在该菜单条名称之前插入，例如 "工具箱"，若为 nil,则插在最后
;;;return:无
;;;example:(BF-AddMenu "ACAD" "CASS工具" items "工具箱")
(defun BF-AddMenu (MenuGroupName POPName PopItems InsertBeforeItem / i menubar menuitem n popupmenu)
  ;;卸载原有菜单
  (BF-RemoveMenuItem POPName)
	
  (setq MenuBar (vla-get-menubar (vlax-get-acad-object)))
  (if InsertBeforeItem
    (progn
      ;; 查找菜单“工具箱”
      (setq n (vla-get-count MenuBar))
      (setq i (1- n))
      (while
				(and (>= i 0)      ; 没有超过上限
					(/= InsertBeforeItem
						(vla-get-name (setq menuitem (vla-item MenuBar i)))
					)        ; 找到"工具箱"菜单条
				)
				(setq i (1- i))
      )
      (if (< i 0)      ; 如果没有文件菜单, 取最后一条菜单菜单
				(setq i (vla-get-count MenuBar))
      )
    )
    (setq i (vla-get-count MenuBar)) ;_  取最后一条菜单菜单
  )
  ;;创建"CASS工具"菜单条
  (if (not
				(setq popupmenu
					(BF-CatchApply
						'vla-Item
						(list
							(vla-get-menus
								(vla-item
									(vla-get-MenuGroups (vlax-get-acad-object))
									MenuGroupName ;_ "测量工具集" 菜单组名称
								)
							)
							POPName ;_ "CASS工具" 下拉菜单名称
						)
					)
				)
      )
    (setq popupmenu
			(vla-add
				(vla-get-menus
					(vla-item (vla-get-MenuGroups (vlax-get-acad-object))
						MenuGroupName ;_ "测量工具集" 菜单组名称
					)
				)
				POPName ;_ "CASS工具" 下拉菜单名称
			)
    )
  )
  ;;清除Menu子项
  (vlax-for popupmenuitem popupmenu
    (vla-delete popupmenuitem)
  )
  ;;插入"CASS工具"菜单条
  (vla-InsertInMenuBar popupmenu i)
  (BF-insertPopMenuItems popupmenu PopItems)
  (princ)
)


;;;name:BF-insertPopMenuItems
;;;desc:逐项插入菜单条，Gu_xl
;;;arg:popupmenu:菜单条vla对象
;;;arg:PopItems:下拉菜单列表,如 '((标签 命令 帮助字串 次级子项)...) 表为下拉菜单列表，注意命令后要有一个空格
;;;return:菜单项列表
;;;example:(BF-insertPopMenuItems popupmenu PopItems)
(defun BF-insertPopMenuItems (popupmenu PopItems / K TMP)
  (setq k 0)
  ;;插入"CASS工具"菜单子项目
  (mapcar
    (function
      (lambda (x / Label cmdstr hlpstr subItems tmp)
				(setq Label    (car x)
					cmdstr   (cadr x)
					hlpstr   (caddr x)
					subItems (cadddr x)
				)
				(if (= label "--")
					;; 插入分隔符
					(vla-AddSeparator
						popupmenu
						(setq k (1+ k))
					)
					(if (and Label cmdstr)
						;; 插入菜单条
						(progn
							(setq tmp
								(vla-addmenuitem
									popupmenu
									(setq k (1+ k))
									Label
									cmdstr
								)
							)
							(vla-put-helpstring tmp hlpstr)
						)
						;; 插入下一级子菜单
						(progn
							(setq tmp
								(vla-addsubmenu
									popupmenu
									(setq k (1+ k))
									Label
								)
							)
							(if subItems ;_ 添加子级菜单
								(BF-insertPopMenuItems tmp subItems)
							)
						)
					)
				)
      )
    )
    ;;'((标签 命令 帮助字串 次级菜单项)) 表为菜单项，注意命令后要有一个空格
    PopItems
  )
)


;;;name:BF-AddToolBars
;;;desc:添加工具条 By Gu_xl 明经通道
;;;arg:MENUGROUPNAME:菜单组名
;;;arg:TOOLBARITEMS:要添加的工具条列表,格式如下:((toolBarName Left Top (Name HelpString Macro SmallIconName [LargeIconName] [FlyoutButton])...)...)
;;;toolBarName ;_ 工具条名称
;;;Left ;_ 工具条在屏幕左边像素坐标
;;;Top ;_ 工具条在屏幕顶部像素坐标
;;;Name ;_ 按钮名称
;;;HelpString ;_ 说明字串
;;;Macro ;_ 命令宏，注意命令后要有一个空格
;;;SmallIconName ;_ 按钮小图标16x16,图像文件要在搜索目录下或在DLL资源文件中
;;;[LargeIconName] ;_ 按钮大图标24x24,图像文件要在搜索目录下或在DLL资源文件中
;;;[FlyoutButton] ;_ 若是浮出按钮，则为 浮出按钮关联的工具条名称字串，否则为nil或不提供
;;;return:无
;;;example:(BF-AddToolBars "ACAD" items)
(defun BF-AddToolBars (MENUGROUPNAME TOOLBARITEMS / flyout flyoutbutton helpstring idx items largeiconname left macro menugroupobj name smalliconname toolbar toolbaritem toolbarname toolbars top)
	
  (if (not (setq menugroupobj
						 (BF-CatchApply
							 vla-item
							 (list
								 (vla-get-MenuGroups (vlax-get-acad-object))
								 MenuGroupName ;_ "测量工具集" 菜单组名称
							 )
						 )
					 )
      )
    (progn
      (alert (strcat "菜单组\""
							 MenuGroupName
							 "\"不存在！无法加载菜单条！"
						 )
      )
      (exit)
    )
  )
  (setq toolBars (vla-get-toolbars menugroupobj)) ;_ 工具条
  (foreach items toolbarItems
    (setq toolBarName (car items) ;_ 工具条名称
			Left        (cadr items) ;_ 工具条 屏幕位置
			Top        (caddr items) ;_ 工具条屏幕位置
			items        (cdddr items)
    )
    (if  (setq toolbar
					 (BF-CatchApply
						 vla-item
						 (list toolBars toolBarName)
					 )
				 )
      (vla-delete toolbar)
    )
    (setq toolbar (vla-add toolBars toolBarName))
    (vla-put-left toolbar left)
    (vla-put-top toolbar Top)
    (setq idx 0)
    (foreach lst items
      (setq name (car lst)
				HelpString (cadr lst)
				Macro (caddr lst)
				SmallIconName (cadddr lst)
				LargeIconName (car (cddddr lst))
				FlyoutButton (cadr (cddddr lst))
      )
      (if (not LargeIconName)
				(setq LargeIconName SmallIconName)
      )
      (if FlyoutButton
				(setq Flyout :vlax-true)
				(setq Flyout :vlax-false)
      )
      (setq ToolbarItem
				(BF-CatchApply
					vla-AddToolbarButton
					(list toolbar idx name HelpString Macro Flyout)
				)
      )
      (BF-CatchApply
				vla-SetBitmaps
				(list ToolbarItem SmallIconName LargeIconName)
      )
      (if FlyoutButton
				(BF-CatchApply
					vla-AttachToolbarToFlyout
					(list ToolbarItem MENUGROUPNAME FlyoutButton)
				)
      )
      (setq idx (1+ idx))
    )
  )
)