;;;name:BF-ent-addpline
;;;desc:生成二维多段线
;;;arg:plist:端点坐标点表，如：((x1 y1 z1) (x2 y2 z2) (x2 y2 z2))或((x1 y1) (x2 y2) (x2 y2))
;;;arg:tudulist:各点与下一点的凸度，可为nil
;;;arg:bg:标高
;;;arg:clo:是否闭合，1:闭合，0：不闭合
;;;return:生成多段线的图元名
;;;example:(BF-ent-addpline '((102.946 68.6354 3) (112.102 97.4851 3) (125.484 59.4879 3) (103.651 52.4513 3)) '(-1.07092 -0.685629 0 -0.31201) 211 1))
(defun BF-ent-addpline (plist tudulist bg clo)
  (if (= clo 1)
    (entmake
      (list '(0 . "POLYLINE") '(66 . 1) '(70 . 1) (cons 38 bg))
    )
    (entmake (list '(0 . "POLYLINE") '(66 . 1) (cons 38 bg)))
  )
  (if tudulist
    (mapcar
      '(lambda (x y)
				 (entmake (list	(cons 0 "VERTEX")
										(cons 10 x)
										(cons 42 y)
									)
				 )
       )
      plist
      tudulist
    )
    (mapcar
      '(lambda (x)
				 (entmake (list	(cons 0 "VERTEX")
										(cons 10 x)
										
									)
				 )
       )
      plist
    )
  )
  (entmake '((0 . "SEQEND")))
  (entlast)
)

;;;name:BF-ent-addarrow
;;;desc:生成箭头
;;;arg:startpt:箭头尖坐标
;;;arg:endpt:箭头尾坐标
;;;arg:width:箭头尾宽度
;;;return:箭头图元名
;;;example:(BF-ent-addarrow (getpoint)(getpoint) 3)
(defun BF-ent-addarrow (startpt endpt width)
  (entmakex
    (list '(000 . "LWPOLYLINE")
			'(100 . "AcDbEntity")
			'(100 . "AcDbPolyline")
			'(090 . 2)
			'(070 . 0)
			(cons 10 startpt)		;端点
			'(40 . 0)			;端点起始宽度
			(cons 41 width)		;端点结束宽度
			(cons 10 endpt)		;端点
			(cons 40 width)		;端点起始宽度
			(cons 41 width)		;端点结束宽度
    )
  )
	
)

;;;name:BF-ent-addarc
;;;desc:创建圆弧
;;;arg:cen:圆心
;;;arg:rad:半径
;;;arg:startpt:起点坐标或弧度
;;;arg:endpt:终点坐标或弧度
;;;return:圆弧图元名
;;;example:(BF-ent-addarc (getpoint) 3 (getpoint) (getpoint))
(defun BF-ent-addarc (cen rad startpt endpt)
  (entmakex
    (list '(000 . "ARC")
			'(100 . "AcDbEntity")
			'(100 . "AcDbCircle")
			'(100 . "AcDbArc")
			(cons 10 cen)			;圆心
			(cons 40 rad)			;半径
			(cons	50
				(if (listp startpt)
					(angle cen startpt)
					startpt
				)
			)				;起始角度
			(cons	51
				(if (listp endpt)
					(angle cen endpt)
					endpt
				)
			)				;结束角度
    )
  )
	
)

;;;name:BF-ent-addcircle
;;;desc:创建圆
;;;arg:cen:圆心
;;;arg:rad:半径
;;;return:圆图元名
;;;example:(BF-ent-addcircle (getpoint) 3)
(DEFUN BF-ent-addcircle	(cen rad)
  (entmakex
    (list
      '(000 . "circle")
      '(100 . "AcDbEntity")
      '(100 . "AcDbCircle")
      (cons 10 cen)
      (cons 40 rad)
    )
  )
	
)

;;;name:BF-ent-addline
;;;desc:创建直线
;;;arg:startpt:起点坐标
;;;arg:endpt:终点坐标
;;;return:直线图元名
;;;example:(BF-ent-addline (getpoint) (getpoint))
(defun BF-ent-addline (startpt endpt)
  (entmakex
    (list '(000 . "LINE")
			'(100 . "AcDbEntity")
			'(100 . "AcDbLine")
			(cons 10 startpt)		;起点
			(cons 11 endpt)		;终点
    )
  )
)

;;;函数名称:BF-Ent-Line
;;;函数说明:在模型空间画直线
;;;参    数:start:起点坐标
;;;参    数:end:终点坐标
;;;返 回 值:直线对象
;;;示    例:(BF-Ent-Line (getpoint) (getpoint))
(defun BF-Ent-Line (start end)
	(vla-AddLine (BF-model-space) (vlax-3D-point start) (vlax-3D-point end))
)




;;;name:BF-ent-addlines
;;;desc:创建连续直线
;;;arg:pts:坐标表
;;;return:图元名列表
;;;example:(BF-ent-addlines (list pt1 pt2 pt3 ...))
(defun BF-ent-addlines (pts)
  (mapcar 'BF-ent-addline (BF-list-rtrim pts 1) (cdr pts))
)

;;;函数名称:BF-Ent-Group
;;;函数说明:创建组
;;;参    数:lst:vla对象表
;;;参    数:name:组名，匿名组为 "*"
;;;返 回 值:组对象
;;;示    例:(BF-Ent-Group lst "*")
(defun BF-Ent-Group (lst name / groupobj)
	(setq groupobj (vla-add (vla-get-Groups (vla-get-ActiveDocument (vlax-get-acad-object))) name)) 
	(vla-AppendItems groupobj (BF-vla-List->Array lst 9))
)


;;;函数名称:BF-Ent-Block
;;;函数说明:创建块
;;;参    数:ss:选择集/vla对象表/图元名表
;;;参    数:name:块名，匿名块为 "*U"
;;;参    数:InsertionPoint:插入点
;;;返 回 值:块对象
;;;示    例:(BF-Ent-Block (ssget) "*U" (getpoint))
(defun BF-Ent-Block (ss name InsertionPoint / block)
  
	(cond 
		((BF-ename-listp ss) (setq ss (BF-vla-ObjArray (mapcar 'vlax-ename->vla-object ss))))
		((BF-vla-listp ss) (setq ss (BF-vla-ObjArray ss)))
		((BF-picksetp ss) (setq ss (BF-pickset->Array ss)))
	)
	(setq block (vla-add (vla-get-Blocks (BF-active-document)) (vlax-3d-point InsertionPoint) name))
	(vla-CopyObjects (BF-active-document) ss block)
	(vla-InsertBlock (BF-model-space) (vlax-3d-point InsertionPoint) (vla-get-Name block) 1 1 1 0)
	(foreach obj (vlax-safearray->list ss) (vla-delete obj))
	block
)



;;;函数名称:BF-Ent-AddObjectstoBlock
;;;函数说明:添加对象到块
;;;参    数:block:块参照对象
;;;参    数:ss:选择集
;;;返 回 值:无
;;;示    例:(BF-Ent-AddObjectstoBlock block ss)
(defun BF-Ent-AddObjectstoBlock (block ss / lst mat)
  (setq 
		
		lst (BF-pickset->vlalist ss)
        mat (BF-Ent-Reference->Definition block)
        mat (vlax-tmatrix (append (mapcar 'append (car mat) (mapcar 'list (cadr mat))) '((0. 0. 0. 1.))))
  )
  (foreach obj lst (vla-transformby obj mat))
 
  (vla-CopyObjects 
		(BF-active-document) 
		(BF-vla-ObjArray lst)
    (vla-item 
			(vla-get-Blocks (BF-active-document)) 
			(vla-get-Name block))
  )

  (foreach obj lst (vla-delete obj))
  (vla-regen (BF-active-document) acAllViewports)
)

;;;函数名称:BF-Ent-Reference->Definition
;;;函数说明:计算块参照与块定义的变换矩阵-leemac
;;;参    数:e:块参照的对象
;;;返 回 值:3x3矩阵和向量组成的表
;;;示    例:(BF-Ent-Reference->Definition e)
(defun BF-Ent-Reference->Definition (e / a n)
  (setq 
		a (vla-get-Rotation e) 
		n (BF-Vla-GetValue (vla-get-Normal e))
	)
  (
    (lambda ( m )
      (list m
        (mapcar '- (BF-Vla-GetValue(vla-get-Origin (vla-item (vla-get-Blocks (BF-active-document)) (vla-get-name e))))
          (BF-Mat-MxV m
            (trans (BF-Vla-GetValue (vla-get-InsertionPoint e)) n 0)
          )
        )
      )
    )
    (BF-Mat-MxM
      (list
        (list (/ 1. (vla-get-XScaleFactor e)) 0. 0.)
        (list 0. (/ 1. (vla-get-YScaleFactor e)) 0.)
        (list 0. 0. (/ 1. (vla-get-ZScaleFactor e)))
      )
      (BF-Mat-MxM
        (list
          (list (cos a) (sin (- a)) 0.)
          (list (sin a) (cos a)     0.)
          (list    0.        0.     1.)
        )
        (mapcar '(lambda ( e ) (trans e n 0 t))
         '(
            (1. 0. 0.)
            (0. 1. 0.)
            (0. 0. 1.)
          )
        )
      )
    )
  )
)






 

;;;name:BF-ent-getbox
;;;desc:图元的最小包围盒
;;;arg:ent:图元名
;;;arg:offset:外框偏移距离
;;;等于0 / nil，不偏移
;;;大于0，向外偏移
;;;小于0，向内偏移
;;;return:外框（偏移后）的左下，右上角点
;;;example:(BF-ent-getbox (car(entsel)) 0.1)
(defun BF-ent-getbox (ent offset / lst obj p1 p2 p3 p4)
  (setq obj (vlax-ename->vla-object ent))
  (vla-GetBoundingBox obj 'p1 'p3)
  (setq	p1 (vlax-safearray->list p1)
		p3 (vlax-safearray->list p3)
  )
  (if (= "SPLINE" (cdr (assoc 0 (entget ent))))
    (progn
      (setq lst
				(mapcar
					'(lambda	(a b)
						 (vlax-curve-getClosestPointToProjection ent a b t)
					 )
					(list p1
						(list (car p1) (cadr p3) (caddr p1))
						p3
						(list (car p3) (cadr p1) (caddr p1))
					)
					'((1.0 0 0) (0 -1.0 0) (-1.0 0 0) (0 1.0 0))
				)
      )
      (setq
				p1 (apply 'mapcar (cons 'min lst))
				p3 (apply 'mapcar (cons 'max lst))
      )
    )
  )
  (if (or (not offset) (equal offset 0 0.0001))
    (list p1 p3)
    (list
      (BF-list- p1 (list offset offset 0))
      (BF-list+ p3 (list offset offset 0))
    )
  )
)




;;;name:BF-Ent-getTextBox
;;;desc:获取单行文本包围框
;;;arg:text:文字图元名
;;;arg:offset:外框偏移距离
;;;等于0 / nil，不偏移
;;;大于0，向外偏移
;;;小于0，向内偏移
;;;return:文字外框（偏移后）的四个角点（左下，右下，右上，左上）
;;;example:(BF-Ent-getTextBox (car(entsel)) 2)
(defun BF-Ent-getTextBox (text offset / pt1 pt2 pts)
  (setq pts (textbox (entget text)))
  (if offset
    (BF-rec-2pt->4pt
      (BF-list- (car pts) (list offset offset 0))
      (BF-list+ (cadr pts) (list offset offset 0))
    )
    pts
  )
)




;;;name:BF-ent-addtext
;;;desc:生成一个TEXT实体,BF-ent-maketext参数简化版
;;;arg:text:文字
;;;arg:pt:文字基点
;;;arg:zg:字高
;;;arg:ang:旋转角度，以(弧度)为单位
;;;arg:dq:对齐样式
;;;0 : 中心
;;;11：左上
;;;12：左中
;;;13：左下
;;;21：中上
;;;22：正中
;;;23：中下
;;;31：右上
;;;32：右中 
;;;33：右下
;;;return:文字图元名
;;;example:(BF-ent-addtext "文字" (getpoint) 3 0 11)
(defun BF-ent-addtext (text pt zg ang dq)
  (BF-ent-maketext text pt zg ang 0.8 0 dq)
)

;;;name:BF-ent-maketext
;;;desc:生成一个TEXT实体,By Longxin 明经通道 2006.04
;;;arg:text:文字
;;;arg:pt:文字基点
;;;arg:zg:字高
;;;arg:ang:旋转角度，以(弧度)为单位
;;;arg:kgb:宽高比
;;;arg:qx:倾斜
;;;arg:dq:对齐样式
;;;0 : 中心
;;;11：左上
;;;12：左中
;;;13：左下
;;;21：中上
;;;22：正中
;;;23：中下
;;;31：右上
;;;32：右中 
;;;33：右下
;;;return:文字图元名
;;;example:(BF-ent-maketext "文字" (getpoint) 3 0 0.8 0 11)
(defun BF-ent-maketext (text pt zg ang kgb qx dqys / y1 y2)
  (cond
    ((= dqys 0)
			(setq y1 (cons 72 4)
				y2 (cons 73 0)
			)
    )
    ((= dqys 11)
			(setq y1 (cons 72 0)
				y2 (cons 73 3)
			)
    )
    ((= dqys 12)
			(setq y1 (cons 72 0)
				y2 (cons 73 2)
			)
    )
    ((= dqys 13)
			(setq y1 (cons 72 0)
				y2 (cons 73 1)
			)
    )
    ((= dqys 21)
			(setq y1 (cons 72 1)
				y2 (cons 73 3)
			)
    )
    ((= dqys 22)
			(setq y1 (cons 72 1)
				y2 (cons 73 2)
			)
    )
    ((= dqys 23)
			(setq y1 (cons 72 1)
				y2 (cons 73 1)
			)
    )
    ((= dqys 31)
			(setq y1 (cons 72 2)
				y2 (cons 73 3)
			)
    )
    ((= dqys 32)
			(setq y1 (cons 72 2)
				y2 (cons 73 2)
			)
    )
    ((= dqys 33)
			(setq y1 (cons 72 2)
				y2 (cons 73 1)
			)
    )
  )
  (entmakex
    (list
      '(0 . "TEXT")
      (cons 10 pt)
      (cons 1 text)
      (cons 40 zg)
      (cons 50 ang)
      (cons 41 kgb)
      (cons 51 qx)
      (cons 7 "standard")
      '(71 . 0)
      y1
      y2
      (cons 11 pt)
    )
  )
)

;;;name:BF-Ent-dimradius
;;;desc:生成半径标注
;;;arg:cen:标注圆心
;;;arg:p2:标注端点
;;;return:标注图元名
;;;example:(BF-Ent-dimradius (getpoint) (getpoint))
(defun BF-Ent-dimradius	(cen p2)
  (entmakex
    (list '(0 . "DIMENSION")
			'(100 . "AcDbEntity")
			'(100 . "AcDbDimension")
			(cons 10 cen)
			'(70 . 36)
			'(100 . "AcDbRadialDimension")
			(cons 15 p2)
    )
  )
)

;;;name:BF-Ent-dimdiameter
;;;desc:生成直径标注
;;;arg:p1:标注端点
;;;arg:p2:标注端点
;;;arg:txtpt:文字位置
;;;return:标注图元名
;;;example:(BF-Ent-dimdiameter (getpoint) (getpoint)(getpoint))
(defun BF-Ent-dimdiameter (p1 p2 txtpt)
  (entmakex
    (list '(0 . "DIMENSION")
			'(100 . "AcDbEntity")
			'(100 . "AcDbDimension")
			(cons 10 p1)
			(cons 11 txtpt)
			'(70 . 163)
			'(100 . "AcDbDiametricDimension")
			(cons 15 p2)
    )
  )
)


;;;name:BF-Ent-dimhorizontal
;;;desc:生成水平标注
;;;arg:p1:标注端点
;;;arg:p2:标注端点
;;;arg:txtpt:文字位置
;;;return:标注图元名
;;;example:(BF-Ent-dimhorizontal (getpoint) (getpoint)(getpoint))
(defun BF-Ent-dimhorizontal (p1 p2 txtpt)
  (entmakex
    (list '(0 . "DIMENSION")
			'(100 . "AcDbEntity")
			'(100 . "AcDbDimension")
			(cons 10 txtpt)
			'(70 . 32)
			'(1 . "")
			'(100 . "AcDbAlignedDimension")
			(cons 13 p1)
			(cons 14 p2)
			'(100 . "AcDbRotatedDimension")
    )
  )
)

;;;name:BF-Ent-Dimvertical
;;;desc:生成垂直标注
;;;arg:p1:标注端点
;;;arg:p2:标注端点
;;;arg:txtpt:文字位置
;;;return:标注图元名
;;;example:(BF-Ent-Dimvertical (getpoint) (getpoint)(getpoint))
(defun BF-Ent-Dimvertical (p1 p2 txtpt)
  (entmakex
    (list '(0 . "DIMENSION")
			'(100 . "AcDbEntity")
			'(100 . "AcDbDimension")
			(cons 10 txtpt)
			'(70 . 32)
			'(1 . "")
			'(100 . "AcDbAlignedDimension")
			(cons 13 p1)
			(cons 14 p2)
			'(50 . 1.5708)
			'(100 . "AcDbRotatedDimension")
    )
  )
)
;;;name:BF-Ent-dimaligned
;;;desc:生成对齐标注
;;;arg:p1:标注端点
;;;arg:p2:标注端点
;;;arg:txtpt:文字位置
;;;return:标注图元名
;;;example:(BF-Ent-dimaligned (getpoint) (getpoint)(getpoint))
(defun BF-Ent-dimaligned (p1 p2 txtpt)
  (entmakex
    (list '(0 . "DIMENSION")
			'(100 . "AcDbEntity")
			'(100 . "AcDbDimension")
			(cons 10 txtpt)
			'(70 . 33)
			'(1 . "")
			'(100 . "AcDbAlignedDimension")
			(cons 13 p1)
			(cons 14 p2)
    )
  )
)




;;;name:BF-ent-addRectangle
;;;desc:构造矩形 by highflybird
;;;arg:pt1:左下坐标
;;;arg:pt2:右上坐标
;;;return:矩形多段线图元名
;;;example:(BF-ent-addRectangle (getpoint) (getpoint))
(defun BF-ent-addRectangle (pt1 pt2)
  (entmake
    (list
      '(0 . "LWPOLYLINE")		;轻多段线
      '(100 . "AcDbEntity")
      '(100 . "AcDbPolyline")
      '(90 . 4)				;四个顶点
      '(70 . 1)				;闭合
      (cons 38 (caddr pt1))		;高程
      (cons 10 (list (car pt1) (cadr pt1))) ;左下角
      (cons 10 (list (car pt2) (cadr pt1))) ;右下角
      (cons 10 (list (car pt2) (cadr pt2))) ;右上角
      (cons 10 (list (car pt1) (cadr pt2))) ;左上角
      (cons 210 '(0 0 1))		;法线方向
    )
  )
  (entlast)
)


;;;name:BF-ent-spline
;;;desc:根据点表画样条曲线
;;;arg:pts:点表
;;;return:样条曲线图元名
;;;example:(BF-ent-spline (list pt1 pt2 pt3 ...))
(defun BF-ent-spline (pts)
  (command "_SPLINE")
  (mapcar 'command pts)
  (command "" "" "")
  (entlast)
)
;;;name:BF-ent-getdxf
;;;desc:获取图元的组码值
;;;arg:ent:图元名或vla对象名
;;;arg:i:组码或组码表
;;;return:组码值或列表
;;;example:(BF-ent-getdxf (car (entsel)) 10)
(defun BF-ent-getdxf (ent i / getdxf)
  ;;取组码函数
  (defun getdxf	(ent i)
    (mapcar 'cdr
	    (vl-remove-if-not '(lambda (x) (= (car x) i)) ent)
    )
  )
  ;;主函数体
  (cond
    ((BF-vlap ent)
			(setq ent (entget (vlax-vla-object->ename ent) '("*")))
    )
    ((BF-enamep ent) (setq ent (entget ent '("*"))))
  )
  (cond
    ((atom i)
			(setq result (getdxf ent i))
    )
    ((listp i)
			(setq
				result (apply 'append (mapcar '(lambda (x) (getdxf ent x)) i))
			)
    )
  )
  (if (= 1 (length result))
    (car result)
    result
  )
)

;;;name:BF-ent-putdxf
;;;desc:更新图元的组码值,根据院长的代码加工了一下
;;;arg:ename:图元，选择集，图元列表
;;;arg:code:组码或组码表
;;;arg:val:值或者值表
;;;return:更新后的图元，选择集，图元列表
;;;example:(BF-ent-putdxf (car (entsel)) 10 '(0 0 0))
(defun BF-ent-putdxf (ename code val / ent)
	
  (cond
    ((BF-enamep ename)
			(setq ent (entget ename))
			(if (and (listp code) (listp val))
				(mapcar '(lambda (x y) (BF-ent-putdxf ename x y)) code val)
				(progn
					(if (null (BF-ent-getdxf ename code))
						(entmod (append ent (list (cons code val))))
						(entmod (subst (cons code val) (assoc code ent) ent))
					)
					(entupd ename)
				)
			)
    )
    ((BF-picksetp ename)
			(foreach s1 (BF-pickset->list ename)
				(BF-ent-putdxf s1 code val)
			)
    )
    ((BF-ename-listp ename)
			(foreach s1 ename
				(BF-ent-putdxf s1 code val)
			)
    )
  )
  ename
)

;;;name:BF-ent-Offset
;;;desc:图元偏移
;;;arg:obj:图元名或vla图元对象
;;;arg:dis:偏移距离，根据正负决定偏移方向
;;;return:偏移后的对象
;;;example:(BF-ent-Offset	(car (entsel)) 0.5)
(defun BF-ent-Offset (obj dis / offsetobj)
  (if (BF-enamep obj)
    (setq obj (vlax-ename->vla-object obj))
  )
  (setq offsetObj (vla-Offset obj dis))
)


;;;name:BF-ent-gettable
;;;desc:返回包含在指定符号表中的所有元素
;;;arg:s:一个符号表名称字符串
;;;LAYER:图层
;;;LTYPE:线型
;;;VIEW：视图
;;;STYLE：字体样式
;;;BLOCK：块
;;;UCS：用户坐标系
;;;APPID：
;;;DIMSTYLE：标注样式
;;;VPORT：视口
;;;return:元素列表
;;;example:(BF-ent-gettable "ltype")
(defun BF-ent-gettable (s / d r)
  (while (setq d (tblnext s (null d)))
    (setq r (cons (cdr (assoc 2 d)) r))
  )
  (reverse r)
)

;;;name:BF-ent-Layers
;;;desc:获取图层列表
;;;arg:
;;;return:图层名列表
;;;example:(BF-ent-Layers)
(defun BF-ent-Layers ()
	; (setq layers-obj (vla-get-Layers doc))
	; (setq layer-list '())
	;(vlax-for i layers-obj
	;	(setq layer-list (append layer-list (list (vla-get-Name i))))
	;)
	;layer-list
  (BF-Ent-ListCollection (BF-Layers))
)
;;;name:BF-Ent-LineTypes
;;;desc:获取线型列表
;;;arg:
;;;return:线型列表
;;;example:(BF-Ent-LineTypes)
(defun BF-Ent-LineTypes	()
  (BF-Ent-ListCollection (BF-LineTypes))
)

;;;name:BF-Ent-TextStyles
;;;desc:获取文字样式列表
;;;arg:
;;;return:文字样式名列表
;;;example:(BF-ent-TextStyles)
(defun BF-Ent-TextStyles ()
  (BF-Ent-ListCollection (BF-TextStyles))
)

;;;name:BF-Ent-ListCollection
;;;desc:返回集合成员名称列表
;;;arg:collection:集合名称
;;;return:集合成员名称列表
;;;example:(BF-Ent-ListCollection (BF-Layers))返回:图层列表("0" "中心线" "文字" "DIM")
(defun BF-Ent-ListCollection (collection / out)
  (vlax-for each collection
    (setq out (cons (vla-get-Name each) out))
  )
  (reverse out)
)

;;;name:BF-ent-onlockedlayer
;;;desc:判断图元是否位于锁定图层
;;;arg:ename:图元名
;;;return:位于锁定图层，t；反之nil
;;;example:(BF-ent-onlockedlayer (car (entsel)))
(defun BF-ent-onlockedlayer (ename / entlst)
  (setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename)))))
  (= 4 (logand 4 (cdr (assoc 70 entlst))))
)


;;;函数名称:BF-ent-makeTextStyle
;;;函数说明:创建默认宋体字宽0.7的字体样式
;;;参    数:name:字体样式名
;;;返 回 值:无
;;;示    例:(BF-ent-makeTextStyle name)
(defun BF-ent-makeTextStyle (name / obj )
  (setq obj (vla-add (vla-get-TextStyles (vla-get-ActiveDocument (vlax-get-acad-object))) name))
	
  (vla-setFont obj "宋体" :vlax-false :vlax-false 1 0)
  (vla-put-Width obj 0.7)
	(princ)
)
;;;name:BF-Ent-ChangeTextStyle
;;;desc:更改指定字体样式的字体
;;;arg:TextStyleName:字体样式名称
;;;arg:FontName:字体名字
;;;arg:BigFontName:大字体名字
;;;return:无
;;;example:(BF-Ent-ChangeTextStyle "STANDARD" "SIMfang.TTF" "")
;;;example:(BF-Ent-ChangeTextStyle "STANDARD" "simplex.shx" "dayuxp.shx")
(defun BF-Ent-ChangeTextStyle
	(TextStyleName FontName BigFontName / txtstyle)
  (setq	TxtStyle (vla-Item
									 (vla-get-textstyles (BF-active-document))
									 TextStyleName
								 )
  )
  (if (wcmatch (vl-filename-extension FontName) ".TTF,.ttf")
    (vla-put-fontfile
      TxtStyle
      (strcat (getenv "Windir") "\\fonts\\" FontName)
    )
    (progn
      (vla-put-fontfile TxtStyle FontName)
      (vla-put-bigfontfile TxtStyle BigFontName)
    )
  )
	
  (vla-regen (BF-active-document) acallviewports)
  (vlax-release-object TxtStyle)
  (princ)
)
;;;name:BF-Ent-Check-Error-Codes
;;;desc:消除字体乱码，利用gbenor.shx gbcbig.shx
;;;arg:doc:当前活动文档
;;;return:无
;;;example:(BF-Ent-Check-Error-Codes (BF-active-document))
(defun BF-Ent-Check-Error-Codes	(doc)
  (vlax-for txtstyle (vla-get-textstyles doc)
    (if	(findfile (vla-get-fontfile txtstyle))
      nil
      (vla-put-fontfile txtstyle "gbenor.shx")
    )
    (if	(findfile (vla-get-bigfontfile txtstyle))
      nil
      (vla-put-bigfontfile txtstyle "gbcbig.shx")
    )
  )
  (princ)
)
;;;name:BF-Ent-DelSameEnt
;;;desc:删除重复图元
;;;arg:ss:选择集
;;;return:无
;;;example:(BF-Ent-DelSameEnt (ssget))
(defun BF-Ent-DelSameEnt (ss / list1 s9 xy)
  (foreach e (BF-pickset->list ss)
    (setq xy (cdr (entget e)))
    (if	(setq s9 (assoc 5 xy))
      (setq xy (subst '(5 . "ASD") s9 xy))
    )
		
    (if	(member xy list1)
      (entdel e)
      (setq list1 (cons xy list1))
    )
  )
  (princ)
)


;;;name:BF-Ent-MakeLayer
;;;desc:创建图层
;;;arg:strName:图层名
;;;arg:intColor:图层颜色
;;;arg:strLtype:图层线型
;;;arg:booleCur:是否置为当前图层
;;;return:成功返回图层名，失败返回nil
;;;example:(BF-Ent-MakeLayer "Layer1" 3 "DASHED" T)
(defun BF-Ent-MakeLayer
	(strName intColor strLtype booleCur / iloc obj out)
  (if (not (tblsearch "layer" strName))
    (progn
      (setq obj (vla-add (BF-Layers) strName))
      (setq iloc (vl-position strName (BF-ent-layers)))
      (if (vlax-Write-Enabled-p obj)
				(progn
					(if intColor
						(vla-put-Color obj intColor)
					)
					(if strLtype
						(BF-ent-change-Ltype obj strLtype)
					)
				)
      )
      (if booleCur
				(vla-put-ActiveLayer
					(BF-active-document)
					(vla-Item (BF-Layers) iloc)
				)
      )
      strName
    )
    nil
  )
)

;;;name:BF-Ltype-Exists
;;;desc:线型是否存在?
;;;arg:strLtype:线型名
;;;return:成功返回t，失败返回nil
;;;example:(BF-Ltype-Exists "continuous")
(defun BF-Ltype-Exists (strLtype)
  (and (member
				 (strcase strLtype)
				 (mapcar 'strcase (BF-Ent-LineTypes))
       )
  )
)

;;;name:BF-ent-change-Ltype
;;;desc:改变对象线型
;;;arg:obj:对象
;;;arg:strLtype:线型
;;;return:成功返回图层名，失败返回nil
;;;example:(BF-ent-change-Ltype cirobj "DASHED")
(defun BF-ent-change-Ltype (obj strLtype / entlist)
  (cond
    ((BF-Ltype-Exists strLtype)
			(cond
				((and
					 (vlax-Read-Enabled-p obj)
					 (vlax-Write-Enabled-p obj)
				 )
					(vla-Put-Linetype obj strLtype)
					T
				)
				(T nil)
			)
    )
    (T nil)
  )
)

;;;name:BF-ent-ActiveLayer
;;;desc:设置指定层为当前层
;;;arg:name:图层名
;;;return:成功返回t，失败返回nil
;;;example:(BF-ent-ActiveLayer "layer1")
(defun BF-ent-ActiveLayer (name / iloc out)
	
  (if (and
				(tblsearch "layer" name)
				(setq iloc (vl-Position name (BF-ent-Layers)))
      )
    (progn
      (vla-put-ActiveLayer
				(BF-active-document)
				(vla-Item (BF-Layers) iloc)
      )
      t
    )
    nil
  )
)


;;;name:BF-ent-LayerOn
;;;desc:图层列表开关函数
;;;arg:LayList:图层名
;;;arg:flag:标志位，t打开图层，nil关闭图层
;;;return:
;;;example:(BF-ent-LayerOn "layer1" t)
(defun BF-ent-LayerOn (LayList flag)
  (vlax-for each (BF-Layers)
    (if	(member	(vla-get-name each)
					(if (listp LayList)
						LayList
						(list LayList)
					)
				)
      (if (vlax-write-enabled-p each)
				(vla-put-LayerOn
					each
					(if flag
						:vlax-True
						:vlax-false
					)
				)
      )
    )
    (vlax-release-object each)
  )
)



;;;name:BF-ent-LayerOn
;;;desc:图层列表冻结开关函数
;;;arg:LayList:图层名
;;;arg:flag:标志位，t冻结图层，nil解冻图层
;;;return:
;;;example:(BF-ent-Freeze "layer1" t)
(defun BF-ent-Freeze (LayList flag)
  (vlax-for each (BF-Layers)
    (if	(member	(vla-get-name each)
					(if (listp LayList)
						LayList
						(list LayList)
					)
				)
      (if (vlax-write-enabled-p each)
				(vla-put-Freeze
					each
					(if flag
						:vlax-True
						:vlax-false
					)
				)
      )
    )
    (vlax-release-object each)
  )
)


;;;name:BF-ent-Plottable
;;;desc:图层打印开关函数
;;;arg:LayList:图层名
;;;arg:flag:标志位，t可打印，nil不可打印
;;;return:
;;;example:(BF-ent-Plottable "layer1" t)
(defun BF-ent-Plottable	(LayList flag)
  (vlax-for each (BF-Layers)
    (if	(member	(vla-get-name each)
					(if (listp LayList)
						LayList
						(list LayList)
					)
				)
      (if (vlax-write-enabled-p each)
				(vla-put-Plottable
					each
					(if flag
						:vlax-True
						:vlax-false
					)
				)
      )
    )
    (vlax-release-object each)
  )
)

;;;name:BF-ent-LayerLock
;;;desc:图层锁定开关函数
;;;arg:LayList:图层名
;;;arg:flag:标志位，t锁定，nil解锁
;;;return:
;;;example:(BF-ent-LayerLock "layer1" t)
(defun BF-ent-LayerLock	(LayList flag)
  (vlax-for each (BF-Layers)
    (if	(member	(vla-get-name each)
					(if (listp LayList)
						LayList
						(list LayList)
					)
				)
      (if (vlax-write-enabled-p each)
				(vla-put-Lock
					each
					(if flag
						:vlax-True
						:vlax-false
					)
				)
      )
    )
    (vlax-release-object each)
  )
)


;;;name:BF-ent-freezelist
;;;desc:返回冻结图层列表
;;;arg:
;;;return:冻结图层列表
;;;example:(BF-ent-freezelist)
(defun BF-ent-freezelist (/ each out)
  (vlax-for each (BF-Layers)
    (if	(= (vla-get-Freeze each) :vlax-true)
      (setq out (cons (vla-get-name each) out))
    )
  )
  out
)

;;;name:BF-Ent-LayerOffList
;;;desc:返回关闭图层列表
;;;arg:
;;;return:关闭图层列表
;;;example:(BF-Ent-LayerOffList)
(defun BF-Ent-LayerOffList (/ each out)
  (vlax-for each (BF-Layers)
    (if	(= (vla-get-LayerOn each) :vlax-false)
      (setq out (cons (vla-get-name each) out))
    )
  )
  out
)


;;;name:BF-ent-Plottablelist
;;;desc:返回可打印图层列表
;;;arg:
;;;return:可打印图层列表
;;;example:(BF-ent-Plottablelist)
(defun BF-ent-Plottablelist (/ each out)
  (vlax-for each (BF-Layers)
    (if	(= (vla-get-Plottable each) :vlax-true)
      (setq out (cons (vla-get-name each) out))
    )
  )
  out
)


;;;name:BF-ent-freezing
;;;desc:层是否冻结？
;;;arg:lname:图层名,区分大小写
;;;return:是-t，否-nil
;;;example:(BF-ent-freezing "DIM")
(defun BF-ent-freezing (lname / each)
  (BF-list-exist (BF-ent-freezelist) lname)
)

;;;函数名称:fontstyle_set
;;;函数说明:验证字体样式是否存在，若不存在，则新建字体样式
;;;参    数:st_name:文字样式名
;;;参    数:h:字高
;;;返 回 值:
;;;示    例:(fontstyle_set "仿宋_GB2312" 0)
(defun fontstyle_set (st_name h / sty)
	(setq sty (tblobjname "style" st_name))
	(if (null sty)
		(progn
			(entmake (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") 
								 (cons 2 st_name) '(70 . 0)
								 (cons 40 h) (cons 41 0.7) '(3 . "仿宋_GB2312.ttf") '(4 . "")
							 )
			)
		)
	)
)

;;;函数名称:activedimstyle
;;;函数说明:激活指定的标注样式。
;;;参    数:dimname:标注样式名
;;;返 回 值:
;;;示    例:(activedimstyle "40")
(defun BF-ent-activedimstyle(dimname / acaddocument acadobject currdimstyle mspace)
	(vl-load-com)
	(setq entname (tblobjname "DIMSTYLE" dimname))
	(setq 
		acadobject(vlax-get-acad-object)
		acaddocument(vla-get-activedocument acadobject)
		mspace(vla-get-modelspace acaddocument)		
	)	　　
	(setq currdimstyle (vlax-ename->vla-object entname))
	(vla-put-activedimstyle acaddocument currdimstyle)
	;(princ (vla-get-name currdimstyle))
	(princ)
)

;;;函数名称:BF-ent-dimstyle
;;;函数说明:创建标注样式
;;;参    数:st_name:标注样式名
;;;返 回 值:
;;;示    例:(dimstyle_set "120")
(defun BF-ENT-Dimstyle (name / my_dimasz my_dimaunit my_dimclrd my_dimclre my_dimclrt my_dimdli my_dimdsep my_dimexe my_dimexo my_dimlfac my_dimlwd my_dimlwe my_dimscale my_dimtad my_dimtih my_dimtix my_dimtofl my_dimtoh my_dimtxt my_dimzin)
	;;;=======AutoLisp用DXF组码来生成标注样式（标注文字样式、标注箭头样式）的样例=======
	;;;运行时输入命令：(Dimstyle_b（1：100）_DXF)，本实例在CAD2010中测试成功。
	;;;转载请注明出处。xq4u，2011年3月8日首发。
	;;;entmake *** "STYLE" *** object:
  (entmake (list
						 '(0 . "STYLE")
						 '(100 . "AcDbSymbolTableRecord")
						 '(100 . "AcDbTextStyleTableRecord")
						 '(2 . "标注")
						 '(70 . 0)
						 '(40 . 0)
						 '(41 . 0.8)
						 '(50 . 0.0)
						 '(71 . 0)
						 '(42 . 2.5)
						 '(3 . "SimSun.ttf")
						 '(4 . "")
					 )
	)
	
	;;;entmake *** "BLOCK" *** object:
  (entmake (list
						 '(0 . "BLOCK")
						 '(100 . "AcDbEntity")
						 '(67 . 0)
						 '(8 . "0")
						 '(100 . "AcDbBlockBegin")
						 '(70 . 0)
						 '(10 0.0 0.0 0.0)
						 '(2 . "_Oblique")
						 '(1 . "")
					 )
	)
	
	;;;entmake *** "LINE" *** object:
  (entmake (list
						 '(0 . "LINE")
						 '(100 . "AcDbEntity")
						 '(67 . 0)
						 '(8 . "0")
						 '(62 . 0)
						 '(6 . "ByBlock")
						 '(370 . -2)
						 '(100 . "AcDbLine")
						 '(10 -0.5 -0.5 0.0)
						 '(11 0.5 0.5 0.0)
						 '(210 0.0 0.0 1.0)
					 )
	)
	
	;;;entmake *** "ENDBLK" *** object:
  (entmake (list
						 '(0 . "ENDBLK")
					 )
	)
	
  (entupd (tblobjname "Block" "_Oblique"))
	
	;;;entmake *** "DIMSTYLE" *** object:
	
	(setq My_DIMSCALE 40);;;DIMSCALE:为标注变量（指定尺寸、距离或偏移量）设置全局比例因子
	(setq My_DIMASZ 2.5);;;DIMASZ:控制尺寸线和引线箭头的大小。并控制基线的大小。
	(setq My_DIMEXO 1);;;DIMEXO:指定尺寸界线偏移原点的距离
	(setq My_DIMDLI 3.75);;;DIMDLI:控制基线标注中尺寸线的间距
	(setq My_DIMEXE 1.25);;;DIMEXE:指定尺寸界线超出尺寸线的距离
	(setq My_DIMTXT 2.5);;;DIMTXT:指定标注文字的高度，除非当前文字样式具有固定的高度
	(setq My_DIMLFAC 1);;;DIMLFAC:设置线性标注测量值的比例因子
	(setq My_DIMTIH 0);;;DIMTIH:控制所有标注类型（坐标标注除外）的标注文字在尺寸界线内的位置
	(setq My_DIMTOH 0);;;DIMTOH:控制标注文字在尺寸界线外的位置
	(setq My_DIMTAD 1);;;DIMTAD:控制文字相对尺寸线的垂直位置
	(setq My_DIMZIN 8);;;DIMZIN:控制是否对主单位值作消零处理
	(setq My_DIMTOFL 1);;;DIMTOFL:控制是否将尺寸线绘制在尺寸界线之间（即使文字放置在尺寸界线之外）
	(setq My_DIMCLRD 256);;;DIMCLRD:为尺寸线、箭头和标注引线指定颜色
	(setq My_DIMCLRE 256);;;DIMCLRE:为尺寸界线指定颜色
	(setq My_DIMCLRT 256);;;DIMCLRT:为标注文字指定颜色
	(setq My_DIMAUNIT 1);;;DIMAUNIT:设置角度标注的单位格式
	(setq My_DIMDSEP 46);;;DIMDSEP:指定一个单字符作为创建十进制标注时使用的小数分隔符
	(setq My_DIMLWD -1);;;DIMLWD:（线宽枚举值）为尺寸线指定线宽。
	(setq My_DIMLWE -1);;;DIMLWE:（线宽枚举值）为延伸线指定线宽。
	(setq My_DIMTIX 1);;;DIMTIX:文字始终保持在尺寸界线之内。
	
  (entmake (list
						 '(0 . "DIMSTYLE")
						 '(100 . "AcDbSymbolTableRecord")
						 '(100 . "AcDbDimStyleTableRecord")
						 (cons 2  name)
						 '(70 . 0)
						 '(141 . 2.5);;;DIMCEN:控制由 DIMCENTER、DIMDIAMETER 和 DIMRADIUS 命令绘制的圆或圆弧的圆心标记和中心线图形
						 '(143 . 0.0393701);;;DIMALTF:控制换算单位中的比例因子
						 '(147 . 0.625);;;DIMGAP:当尺寸线分成段以在两段之间放置标注文字时，设置标注文字周围的距离
						 '(171 . 3);;;DIMALTD:控制换算单位中小数位的位数
						 '(271 . 1);;;DIMDEC:为所有标注类型（角度标注除外）的换算标注测量值指定文字前缀或后缀（或两者都指定）
						 '(272 . 1);;;DIMTDEC:为标注主单位的公差值设置显示的小数位位数
						 '(274 . 3);;;DIMALTTD:设置换算标注单位中的公差值的小数位数
						 '(283 . 0);;;DIMTOLJ:设置公差值相对于表面标注文字的垂直对正方式。
						 '(284 . 8);;;DIMTZIN:控制是否对公差值作消零处理
						 (cons 40 My_DIMSCALE)
						 (cons 41 My_DIMASZ)
						 (cons 42 My_DIMEXO)
						 (cons 43 My_DIMDLI)
						 (cons 44 My_DIMEXE)
						 (cons 140 My_DIMTXT)
						 (cons 144 My_DIMLFAC)
						 (cons 73 My_DIMTIH)
						 (cons 74 My_DIMTOH)
						 (cons 77 My_DIMTAD)
						 (cons 78 My_DIMZIN)
						 (cons 172 My_DIMTOFL)
						 (cons 174 My_DIMTIX)		 
						 (cons 176 My_DIMCLRD)
						 (cons 177 My_DIMCLRE)
						 (cons 178 My_DIMCLRT)
						 (cons 275 My_DIMAUNIT)
						 (cons 278 My_DIMDSEP)
						 (cons 371 My_DIMLWD)
						 (cons 372 My_DIMLWE)
						 (cons 340 (tblobjname "STYLE" "标注"));;;DIMTXSTY:（参照的 STYLE 的句柄）指定标注的文字样式。
						 (cons 342 (cdr (assoc 330 (entget (tblobjname "BLOCK" "_Oblique")))));;;DIMBLK:（参照的 BLOCK 的句柄）设置尺寸线或引线末端显示的箭头块。
					 )
	)
	
  (entupd (tblobjname "Dimstyle" name))
	
  (princ)	;静默退出
)


;;;函数名称:BF-ent-addHatch
;;;函数说明:创建充填
;;;参    数:outArray:外边界对象表
;;;参    数:inArray:内边界对象表
;;;参    数:name:充填名称
;;;返 回 值:充填体对象
;;;示    例:(BF-ent-addHatch outArray inArray name)
(defun BF-ent-addHatch (outArray inArray name / hatchobj)
  
  (setq hatchObj (vla-AddHatch (BF-model-space) AcHatchPatternTypePreDefined name :vlax-true))
  (vla-AppendOuterLoop hatchObj (BF-vla-ObjArray (mapcar 'vlax-ename->vla-object outArray)))
  (if inArray
    (vla-AppendInnerLoop hatchObj (BF-vla-ObjArray (mapcar 'vlax-ename->vla-object inArray)))
  )
  (vla-put-PatternScale hatchObj 40)
  hatchObj
)