;;;name:BF-point-3d->2d
;;;desc:根据三维点坐标返回二维点坐标
;;;arg:3dpt:三维点坐标
;;;return:二维点坐标
;;;example:(BF-point-3d->2d	'(1 1 0))
(defun BF-point-3d->2d (3dpt)
  (if (listp 3dpt)
    (list (float (car 3dpt)) (float (cadr 3dpt)))
  )
)

;;;name:BF-point-2d->3d
;;;desc:无条件转换为3维点
;;;arg:p:点坐标或数
;;;return:三维点坐标
;;;example:(BF-point-2d->3d	'(1 1))
(defun BF-point-2d->3d (p)
  (cond
    ((listp p)
			(if (= 1 (length p))
				(list (float (car p)) 0.0 0.0)
				(if (= 2 (length p))
					(list (float (car p)) (float (cadr p)) 0.0)
					(mapcar 'float p)
				)
			)
    )
    ((bf-realp p) (list p 0.0 0.0))
    ((BF-intp p) (list (float p) 0.0 0.0))
    (t nil)
  )
)

;;;name:BF-rec-2pt->4pt
;;;desc:根据矩形2点计算矩形4点
;;;arg:pt1:任意对角点
;;;arg:pt2:pt1的对角点
;;;return:矩形的四个角点坐标
;;;example:(BF-rec-2pt->4pt '(0 0) '(2 2))
(defun BF-rec-2pt->4pt (pt1 pt2)
	(mapcar   
		'(lambda (x)
			 (mapcar 'apply x (mapcar 'list pt1 pt2))) 
		'(
			 (min min)
			 (max min)
			 (max max)
			 (min max)
		 )
	)
)
;;;name:BF-curve-join
;;;desc:合并多段线函数
;;;arg:entlst:选择集或图元列表，vla对象列表
;;;arg:fuzz:容差值
;;;return:合并后的多段线图元名
;;;example:(BF-curve-join '(ent1 ent2 ent3 ..) 0.000001)
(defun BF-curve-join (entlst fuzz)
  (setq oldpeditaccept (getvar "PEDITACCEPT"))
  (setvar "PEDITACCEPT" 1)
  (if (= fuzz nil)
    (setq fuzz 1e-6)
  )
  (if (not (BF-picksetp entlst))
    (cond
      ((BF-ename-listp entlst)
				(setq entlst (BF-entlist->pickset entlst))
      )
      ((BF-vla-listp entlst)
				(setq entlst (BF-entlist->pickset (mapcar 'BF-vla->e entlst)))
      )
    )
  )
  (command "_.pedit" "_M" entlst "" "_J" "_J" "_B" fuzz "")
  (setvar "cmdecho" 0)
  (setvar "PEDITACCEPT" oldpeditaccept)
  (entlast)
)



;;;name:BF-curve-inters
;;;desc:获取对象交点列表
;;;arg:obj1:选择集，vla对象，图元名，vla对象表，图元表，nil
;;;arg:obj2:选择集，vla对象，图元名，vla对象表，图元表，nil
;;;obj1 和 obj2 参数可任意组合，但不能全为nil
;;;arg:mode: 该参数只有obj1、obj2为图元或vla对象时，服从下列设置，其他情况均默认对象不延伸
;;;acExtendNone 对象不延伸
;;;acExtendThisEntity 延伸obj1
;;;acExtendOtherEntity 延伸obj2
;;;acExtendBoth 对象都延伸
;;;nil = acExtendNone 对象不延伸
;;;return:对象交点列表
;;;example:(BF-curve-inters obj1 obj2 acExtendNone)
(defun BF-curve-inters (obj1	       obj2	      mode
												 /	       getinterpts    inter-objlist
												 inter-objlists inter-picksets inter-ss
												 inter-ss-obj   res
											 )
  (or mode (setq mode acExtendNone))
  ;;==内部子函数==
  ;;===============
  ;;对象交点函数
  (defun getinterpts (obj1 obj2 mode / iplist)
    (or	(BF-vlap obj1)
			(setq obj1 (vlax-ename->vla-object obj1))
    )
    (or	(BF-vlap obj2)
			(setq obj2 (vlax-ename->vla-object obj2))
    )
    (setq iplist
			(vl-catch-all-apply
				'vlax-safearray->list
				(list
					(vlax-variant-value
						(vla-intersectwith obj1 obj2 mode)
					)
				)
			)
    )
    (if	(vl-catch-all-error-p iplist)
      nil
      (BF-list-split-3d iplist)
    )
  )
	
  ;;对象与选择集交点函数
  (defun inter-ss-obj (ss obj / res1)
    (foreach i (BF-pickset->vlalist ss)
      (setq res1 (append res1 (getinterpts i obj acExtendNone)))
    )
    res1
  )
  ;;选择集交点函数
  (defun inter-ss (ss)
    (inter-objlist (BF-pickset->vlalist ss))
		
  )
	;vla对象列表交点函数
  (defun inter-objlist (lst / ob1 rtn)
    (while (setq ob1 (car lst))
      (foreach ob2 (setq lst (cdr lst))
				(setq rtn (cons (getinterpts ob1 ob2 acextendnone) rtn))
      )
    )
    (apply 'append (reverse rtn))
  )
	;两个vla对象表交点函数
  (defun inter-objlists	(ol1 ol2 / rtn)
    (foreach ob1 ol1
      (foreach ob2 ol2
				(setq rtn (cons (getinterpts ob1 ob2 acextendnone) rtn))
      )
    )
    (apply 'append (reverse rtn))
  )
	;两个选择集交点函数
  (defun inter-picksets	(ss1 ss2)
    (inter-objlists
      (BF-pickset->vlalist ss1)
      (BF-pickset->vlalist ss2)
    )
  )
	
	
	;==判断参数类型并调用不同的内部子函数==
  (cond
    ((and (or (BF-vlap obj1) (BF-enamep obj1))
			 (or (BF-vlap obj2) (BF-enamep obj2))
     )
			(setq res (getinterpts obj1 obj2 mode))
    )					;两个对象
		
    ((and (or (BF-vlap obj1) (BF-enamep obj1))
			 (BF-picksetp obj2)
     )
			(setq res (inter-ss-obj obj2 obj1))
    )					;一个对象一个选择集
		
    ((and (or (BF-vlap obj2) (BF-enamep obj2))
			 (BF-picksetp obj1)
     )
			(setq res (inter-ss-obj obj1 obj2))
    )					;一个对象一个选择集
		
    ((and (BF-picksetp obj1) (not obj2))
			(setq res (inter-ss obj1))
    )					;单独一个选择集
		
    ((and (BF-picksetp obj2) (not obj1))
			(setq res (inter-ss obj2))
    )					;单独一个选择集
		
    ((and (BF-picksetp obj1) (BF-picksetp obj2))
			(setq res (inter-picksets obj1 obj2))
    )					;两个选择集
		
    ((and (BF-vla-listp obj1) (not obj2))
			(setq res (inter-objlist obj1))
    )					;一个对象列表
		
    ((and (BF-vla-listp obj2) (not obj1))
			(setq res (inter-objlist obj2))
    )					;一个对象列表
		
    ((and (BF-vla-listp obj1) (BF-vla-listp obj2))
			(setq res (inter-objlists obj1 obj2))
    )					;两个对象列表
		
    ((and (BF-ename-listp obj1) (not obj2))
			(setq res (inter-objlist (BF-enamelist->vla obj1)))
    )					;一个图元列表
		
    ((and (BF-ename-listp obj2) (not obj1))
			(setq res (inter-objlist (BF-enamelist->vla obj2)))
    )					;一个图元列表
		
    ((and (BF-ename-listp obj1) (BF-ename-listp obj2))
			(setq res (inter-objlists
									(BF-enamelist->vla obj1)
									(BF-enamelist->vla obj2)
								)
			)
    )					;两个图元列表
		
    (t (setq res nil))			;都不符合条件，则返回nil
  )
  res
)

;;;name:BF-curve-putClosed
;;;desc:使多段线封闭By 自贡黄明儒
;;;arg:obj:多段线对象
;;;return:无
;;;example:(BF-curve-putClosed (car (entsel)))
(defun BF-curve-putClosed (obj)
  (or (BF-vlap obj) (setq obj (vlax-ename->vla-object obj)))
  (if (not (vlax-curve-isclosed obj))
    (vla-put-closed obj :vlax-true)
  )
)

;;;name:BF-curve-Pline-2dpoints
;;;desc:多段线端点列表，返回二维点坐标 By 自贡黄明儒
;;;arg:obj:多段线对象
;;;return:二维点坐标列表
;;;example:(BF-curve-Pline-2dpoints (car (entsel)))
(defun BF-curve-Pline-2dpoints (en)
  (mapcar 'cdr
	  (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))
  )
)

;;;name:BF-curve-pline-3dpoints
;;;desc:多段线端点列表，返回三维点坐标 By 无痕
;;;arg:obj:多段线对象
;;;return:三维点坐标列表
;;;example:(BF-curve-pline-3dpoints (car (entsel)))
(defun BF-curve-pline-3dpoints (e / i lst v)
  (setq i -1)
  (while
    (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
		(setq lst (cons v lst))
  )
  (reverse lst)
)


;;;name:BF-curve-Rectangle-Center
;;;desc:矩形中点坐标 By 自贡黄明儒
;;;arg:obj:矩形对象
;;;return:矩形中点坐标
;;;example:(BF-curve-Rectangle-Center (car (entsel)))
(defun BF-curve-Rectangle-Center (en / pl)
  (setq pl (BF-curve-Pline-2dpoints en))
  (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car pl) (caddr pl))
)

;;;name:BF-curve-Param-FirstAngle
;;;desc:曲线参数param处的切线方向的角度
;;;arg:obj:曲线
;;;arg:param:曲线参数值，从0开始
;;;return:弧度制角度值
;;;example:(BF-curve-Param-FirstAngle (car (entsel)) 0)
(defun BF-curve-Param-FirstAngle (obj param / pt)
  (setq pt (vlax-curve-getpointatparam obj param))
  (angle '(0 0 0) (vlax-curve-getFirstDeriv obj param))
)

;;;name:BF-curve-Param-SecondAngle
;;;desc:曲线参数param处的法线方向的角度
;;;arg:obj:曲线
;;;arg:param:曲线参数值，从0开始
;;;return:弧度制角度值
;;;example:(BF-curve-Param-SecondAngle (car (entsel)) 0)
(defun BF-curve-Param-SecondAngle (obj param / pt)
  (setq pt (vlax-curve-getpointatparam obj param))
  (angle '(0 0 0) (vlax-curve-getSecondDeriv obj param))
)

;;;name:BF-curve-Point-FirstAngle
;;;desc:曲线一点的切线方向的角度
;;;arg:obj:曲线
;;;arg:pt:曲线上一点的坐标
;;;return:弧度制角度值
;;;example:(BF-curve-Point-FirstAngle (car (entsel)) (getpoint))
(defun BF-curve-Point-FirstAngle (obj pt / param)
  (setq param (vlax-curve-getParamAtPoint obj pt))
  (angle '(0 0 0) (vlax-curve-getFirstDeriv obj param))
)

;;;name:BF-curve-Point-SecondAngle
;;;desc:曲线一点的法线方向的角度
;;;arg:obj:曲线
;;;arg:pt:曲线上一点的坐标
;;;return:弧度制角度值
;;;example:(BF-curve-Point-SecondAngle (car (entsel)) (getpoint))
(defun BF-curve-Point-SecondAngle (obj pt / param)
  (setq param (vlax-curve-getParamAtPoint obj pt))
  (angle '(0 0 0) (vlax-curve-getSecondDeriv obj param))
)

;;;name:BF-curve-PtOnCurve
;;;desc:判断点是否在曲线上
;;;arg:curve:曲线
;;;arg:pt:点的坐标
;;;return:在曲线上返回T，反之nil
;;;example:(BF-curve-PtOnCurve (getpoint) (car (entsel)))
(defun BF-curve-PtOnCurve (pt curve)
  (equal pt (vlax-curve-getClosestPointTo curve pt) 0.00001)
)

;;;name:BF-curve-Length
;;;desc:曲线长度
;;;arg:curve:曲线，直线、圆弧、圆、多段线、优化多段线、样条曲线等图元
;;;return:曲线的长度
;;;example:(BF-curve-Length (car (entsel)))
(defun BF-curve-Length (curve)
  (vlax-curve-getDistAtParam
    curve
    (vlax-curve-getEndParam curve)
  )
)

;;;name:BF-curve-subsegments
;;;desc:多段线子段数量
;;;arg:curve:多段线
;;;return:子段的数量
;;;example:(BF-curve-subsegments (car (entsel)))
(defun BF-curve-subsegments (obj)
  (if (vlax-curve-isClosed obj)
    (fix (1- (vlax-curve-getendParam obj)))
    (fix (vlax-curve-getendParam obj))
  )
)

;;;name:BF-curve-Midpoint
;;;desc:曲线中点
;;;arg:curve:曲线
;;;return:中点坐标
;;;example:(BF-curve-Midpoint (car (entsel)))
(defun BF-curve-Midpoint (curve)
  (vlax-curve-getPointAtDist
    curve
    (/ (BF-curve-Length curve) 2)
  )
)


;;;name:BF-curve-subsegment-points
;;;desc:多段线第n子段的端点坐标
;;;arg:curve:多段线
;;;arg:n:第n个子段
;;;return:子段的端点坐标列表
;;;example:(BF-curve-subsegment-points (car (entsel)) 2)
(defun BF-curve-subsegment-points (curve n)
  (list	(vlax-curve-getPointAtParam curve (fix n))
		(vlax-curve-getPointAtParam curve (1+ (fix n)))
  )
)

;;;name:BF-curve-picked-subsegment-Points
;;;desc:多段线所点击子段的两端点列表
;;;arg:obj:多段线
;;;arg:p:点击点
;;;return:点击子段的端点坐标列表
;;;example:(BF-curve-picked-subsegment-Points (car(setq en(entsel))) (cadr en))
(defun BF-curve-subsegment-picked-Points (obj p)
  (BF-curve-subsegment-points
    obj
    (fix
      (vlax-curve-getParamAtPoint
				obj
				(vlax-curve-getClosestPointTo obj (trans p 1 0))
      )
    )
  )
)

;;;name:BF-curve-PickClosePointto
;;;desc:多段线上距离点击点最近的一个顶点  By 自贡黄明儒
;;;arg:obj:多段线
;;;arg:p:点击点
;;;return:顶点坐标
;;;example:(BF-curve-PickClosePointto (car(setq en(entsel))) (cadr en))
(defun BF-curve-PickClosePointto (obj p / p1 p2 pp)
  (setq pp (BF-curve-subsegment-picked-Points obj p))
  (setq p1 (car pp))
  (setq p2 (cadr pp))
  (if (< (distance p p1) (distance p p2))
    p1
    p2
  )
)

;;;name:BF-curve-subsegment-picked-param
;;;desc:多段线所点击子段参数  By 自贡黄明儒
;;;arg:obj:多段线
;;;arg:p:点击点
;;;return:子段的参数
;;;example:(BF-curve-subsegment-picked-param (car(setq en(entsel))) (cadr en))
(defun BF-curve-subsegment-picked-param	(obj p / PP)
  (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0)))
  (fix (vlax-curve-getParamAtPoint obj pp))
)

;;;name:BF-curve-subsegment-length
;;;desc:多段线子段长度  By 自贡黄明儒
;;;arg:obj:多段线
;;;arg:pt1:子段的起点坐标或参数
;;;arg:pt1:子段的终点坐标或参数
;;;return:子段的长度
;;;example:(BF-curve-subsegment-length (car(entsel)) 0 1)
(defun BF-curve-subsegment-length (obj pt1 pt2)
  (cond
    ((and (listp pt1) (listp pt2))
			(abs (- (vlax-curve-getDistAtPoint obj pt1)
						 (vlax-curve-getDistAtPoint obj pt2)
					 )
			)
    )
    (t
			(abs (- (vlax-curve-getDistAtParam obj pt1)
						 (vlax-curve-getDistAtParam obj pt2)
					 )
			)
    )
  )
	
)

;;;name:BF-curve-subsegment-Picked-type
;;;desc:多段线子段图元类型
;;;arg:obj:多段线
;;;arg:p:点击子段的坐标或参数
;;;return:表示子段图元类型的字符串，直线为line，圆弧为arc
;;;example:(BF-curve-subsegment-Picked-type (car(entsel)) 0)
;;;(BF-curve-subsegment-Picked-type (car(setq en(entsel))) (cadr en))
(defun BF-curve-subsegment-Picked-type (curve p / PP)
  (if (listp p)
    (progn
      (setq pp (vlax-curve-getclosestpointto curve (trans p 1 0)))
      (setq pp (vlax-curve-getSecondDeriv
								 curve
								 (fix (vlax-curve-getparamatpoint curve pp))
							 )
      )
    )
    (setq pp (vlax-curve-getsecondDeriv curve p))
  )
  (if (equal pp '(0.0 0.0 0.0))
    "line"
    "arc"
  )
)

;;;name:BF-curve-checkarc
;;;desc:判断多段线是否有圆弧(凸度/=0)的子段
;;;arg:en:多段线图元名
;;;return:有圆弧返回t，反之nil
;;;example:(BF-curve-checkarc (car(entsel)))
(defun BF-curve-checkarc (en / G)
  (setq G (vl-remove-if-not '(lambda (x) (= (car x) 42)) (entget en)))
  (not (vl-every 'zerop (mapcar 'cdr G)))
)

;;;name:BF-curve-subsegment-parameter
;;;desc:多段线子段参数
;;;arg:curve:多段线图元名
;;;arg:pt:点击点
;;;return:根据子段类型不同返回不同的参数
;;;直线：起点，终点，长度，角度
;;;弧：圆心，起点，终点，切线交点，半径，包含角，弧长，切线交点长
;;;example:(BF-curve-subsegment-parameter (car(setq en(entsel))) (cadr en))
(defun BF-curve-subsegment-parameter (curve	pt	  /
																			 arclength	cenangle  center
																			 points	pt1	  pt1param
																			 pt2	pt3	  radius
																			 tlength	xangle	  xbulge
																		 )
	
  (setq	points	  (BF-curve-subsegment-picked-Points curve pt)
		;端点坐标
		pt1	  (car points)		;子段起点
		pt2	  (cadr points)		;子段终点
		pt1param  (vlax-curve-getParamAtPoint curve pt1) ;子段起点参数
		arclength (BF-curve-subsegment-length curve pt1 pt2) ;弧长
  )
  (setq xbulge (vla-GetBulge (vlax-ename->vla-object curve) pt1param))
	;凸度
  (if (= 0 xbulge)
    (progn
      (list pt1 pt2 arclength (angle pt1 pt2))
    )
    (progn
      (setq xAngle   (* 4 (atan xBulge)) ;包含角
				cenAngle ((if (< xBulge 0)
										-
										+
									)
									 (- (angle pt1 pt2) (/ xAngle 2.0))
									 (/ PI 2)
								 )			;起点半径的角度
				radius   (abs (/ (/ (distance pt1 pt2) 2.0) (sin (/ xAngle 2.0))))
				;半径
				center   (polar pt1 cenAngle radius) ;圆心
				
				PT3	     (inters
									 PT1
									 (polar pt1 (+ (angle pt1 center) (/ pi 2)) radius)
									 PT2
									 (polar pt2 (+ (angle pt2 center) (/ pi 2)) radius)
									 nil
								 )			;切线交点
				tlength  (if (null pt3)
									 0
									 (distance PT2 PT3)
								 )
      )
      (list center			;圆心坐标  
				pt1				;子段起点
				pt2				;子段终点
				pt3				;切线交点
				radius			;半径
				(abs xAngle)		; 包含角
				arclength			;弧长
				tlength
      )					;t长
			
    )
  )
	
)

;;;name:BF-curve-Clockwisep
;;;desc:判断多段线方向
;;;arg:en:多段线图元名
;;;return:顺时针返回t，反之nil
;;;example:(BF-curve-Clockwisep (car(entsel)))
(defun BF-curve-Clockwisep (en / fx offsetObj plineObj)
  (setq plineObj (vlax-ename->vla-object en))
  (setq	offsetplineObj
		(car (vlax-safearray->list
					 (vlax-variant-value
						 (vla-OFFSET plineObj 0.0001)
					 )
				 )
		)
  )
  (if
    (> (vlax-curve-getdistatparam
				 plineobj
				 (vlax-curve-getEndParam plineobj)
       )
			(vlax-curve-getdistatparam
				offsetplineObj
				(vlax-curve-getEndParam offsetplineObj)
			)
    )
		(setq fx t)
		(setq fx nil)
  )
  (vla-delete offsetplineObj)
  fx
)