;;; |标注合并和断开程序
;;; |断开dimbreak,合并dimcombine
;;; |snsj 2004.4.8
(defun zm (et x /)
	(cdr (assoc x (entget et)))
)
(defun pzm (nwzm y obj /)
	(entmod (subst
						(cons y nwzm)
						(assoc y (entget obj))
						(entget obj)
					)
	)
)
(defun objnm (ent)
	(vla-get-objectname (vlax-ename->vla-object ent))
)
(defun maxlst (pts / js i x tt jl ds)
	(setq js 0
				i 0
	)
	(repeat (length pts)
		(setq tt (nth i pts))
		(mapcar
			'(lambda (x)
				 (if (> (setq ds (distance tt x))
								js
						 )
					 (setq js ds
								 jl (list x tt)
					 )
				 )
			 )
			pts
		)
		(setq i (1+ i))
	)
	jl
)
;;; |标注断开
(defun c:dimbreak (/ ENT ENT1 GETPT JPT PT1 PT2 XL)
	(vl-load-com)
	(vl-cmdf "undo" "be")
	(if (setq ent (car (entsel "\n选择要断开的标注<退出>:")))
		(progn
			(redraw ent 3)
			(setq getpt (getpoint "\n点取断开点:"))
			(redraw ent 4)
			(vl-cmdf ".copy" ent "" '(0 0) "@")
			(setq ent1 (entlast))
			(setq pt1 (zm ent 13)
						pt2 (zm ent 14)
			)
			(if (= (objnm ent) "AcDbAlignedDimension")
				(vl-cmdf ".xline" pt1 pt2 "")
				(vl-cmdf ".xline" "a" (angtos (zm ent 50) 0 4) pt1 "")
			)
			(setq xl (entlast))
			(pzm (setq jpt (vlax-curve-getClosestPointTo xl getpt))
					 13 ent
			)
			(pzm jpt 14 ent1)
			(vl-cmdf ".erase" xl "")
		)
	)
	(vl-cmdf "undo" "e")
	(princ)
)
;;; |标注合并
(defun c:dimcombine (/ ANG1 ANG2 ENT ENT1 MAXPT PT1 PT2 PT3 PT4 PT5 PT6 PT7
											 XL
										)
	(vl-load-com)
	(vl-cmdf "undo" "be")
	(if (setq ent (car (entsel "\n选择要合并对标注<退出>:")))
		(progn
			(redraw ent 3)
			(setq ent1 (car (entsel "\n选择另一个标注对象<退出>:")))
			(redraw ent 4)
			(setq pt1 (zm ent 13)
						pt2 (zm ent 14)
						pt3 (zm ent1 13)
						pt4 (zm ent1 14)
			)
			(if (= (objnm ent) "AcDbAlignedDimension")
				(setq ang1 (angle pt1 pt2))
				(setq ang1 (zm ent 50))
			)
			(if (= (objnm ent1) "AcDbAlignedDimension")
				(setq ang2 (angle pt3 pt4))
				(setq ang2 (zm ent1 50))
			)
			(if (or
						(or
							(equal ang2 ang1 0.00001)
							(equal (+ pi ang2) ang1 0.00001)
						)
						(equal (- ang2 pi) ang1 0.00001)
					)
				(progn
					(vl-cmdf ".xline" "a" (angtos ang1 0 4) pt1 "")
					(setq xl (entlast))
					(setq pt5 (vlax-curve-getClosestPointTo xl pt2)
								pt6 (vlax-curve-getClosestPointTo xl pt3)
								pt7 (vlax-curve-getClosestPointTo xl pt4)
					)
					(setq maxpt (maxlst (list pt1 pt5 pt6 pt7)))
					(pzm (car maxpt) 13 ent)
					(pzm (cadr maxpt) 14 ent)
					(vl-cmdf ".erase" xl ent1 "")
				)
			)
		)
	)
	(vl-cmdf "undo" "e")
	(princ)
)
