;; Advanced LWPolyline Outline  -  Lee Mac
;; Example calling functions (these may be customised to suit your requirements):


;; Multiple selection

(defun c:lm_mpolyout ( / *error* cmd del enl ent err lst ped sel )
	(mai_last_com "lm_mpolyout")

	(defun *error* ( msg )
		(if (= 'int (type cmd))
			(setvar 'cmdecho cmd)
		)
		(if (= 'int (type ped))
			(setvar 'peditaccept ped)
		)
		(LM:endundo (LM:acdoc))
		(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
			(princ (strcat "\nError: " msg))
		)
		(princ)
	)

	(if
		(setq sel
			(LM:ssget "\n选择多段线LWPolylines :"
				'(
					"_:L"
					(
						(0 . "LWPOLYLINE")
						(-4 . "<OR")
							(-4 . "<>") (40 . 0.0)
							(-4 . "<>") (41 . 0.0)
						(-4 . "OR>")
					)
				)
			)
		)
		(progn
			(initget "Yes No")
			(setq del (/= "No" (getkword "\n是否删除原有多段线? [是(Yes)/否(No)]:<Yes>")))
			(LM:startundo (LM:acdoc))
			(setq
				cmd (getvar 'cmdecho)
				ped (getvar 'peditaccept)
				err 0
			)
			(setvar 'cmdecho 0)
			(setvar 'peditaccept 1)
			(foteach sel (mai_ssget_2_list sel)
				(setq
					enl (entlast)
					lst nil
				)
				(LM:AdvPolyOutline ent)
				(if (equal enl (entlast))
					(setq err (1+ err))
					(progn
						(while (setq enl (entnext enl))
							(if (wcmatch (mai_dxf 0 enl) "LINE,ARC")
								(setq lst (cons enl lst))
							)
						)
						(if lst
							(progn
								(command "_.pedit" "_M")
								(foreach x lst (command x))
								(command "" "_J" "" "")
							)
						)
						(if del (entdel ent))
					)
				)
			)
			(if (< 0 err)
				(princ (strcat "\n选择的多段线不能提取外框 " (itoa err) " ."))
			)
			(setvar 'cmdecho cmd)
			(setvar 'peditaccept ped)
			(LM:endundo (LM:acdoc))
		)
	)
	(princ)
)

;;------------------=={ Advanced LWPolyline Outline }==-----------------;;
;;                                                                      ;;
;;  Constructs the outline silhouette of an LWPolyline entity with      ;;
;;  straight and arc segments of varying width. The resulting           ;;
;;  silohuette is composed of Line, Circular Arc & Elliptical Arc       ;;
;;  entities.                                                           ;;
;;                                                                      ;;
;;  The function is currently limited for use with                      ;;
;;  non-self-intersecting LWPolylines.                                  ;;
;;                                                                      ;;
;;  The function will produce best results for arc segments whose       ;;
;;  vertex locations have not been independently modified following     ;;
;;  creation of the LWPolyline; i.e. arc segments which remain tangent  ;;
;;  to surrounding segments.                                            ;;
;;                                                                      ;;
;;  The function will approximate LWPolyline arc segments that have a   ;;
;;  varying start & end width with an Elliptical Arc entity; however,   ;;
;;  arc segments spanning more than pi radians, or with a high width    ;;
;;  differential along the length of the segment will not necessarily   ;;
;;  define an outlining Elliptical Arc.                                 ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright ?2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Arguments:                                                          ;;
;;  ent - Entity name of LWPolyline                                     ;;
;;----------------------------------------------------------------------;;
;;  Returns:  -None-                                                    ;;
;;----------------------------------------------------------------------;;

(defun LM:AdvPolyOutline ( ent / _endpoints cls enx ep1 ep2 lst ocs )

(defun _endpoints ( en bu / ax bx cn mt p1 pl ra rd zv )
	(setq
		en (entget en)
		zv (mai_dxf 210 en)
	)
	(setq pl
		(cond
			(	(= "LINE" (mai_dxf 0 en))
				(list
					(mai_dxf 10 en)
					(mai_dxf 11 en)
				)
			)

			(	(= "ARC" (mai_dxf 0 en))
				(setq
					cn (mai_dxf 10 en)
					rd (mai_dxf 40 en)
				)
				(mapcar '(lambda ( a ) (trans (polar cn (mai_dxf a en) rd) zv 0)) '(50 51))
			)

			(	t
				(setq
					cn (trans (mai_dxf 10 en) 0 zv)
					p1 (trans (mai_dxf 11 en) 0 zv)
					ax (distance '(0.0 0.0) p1)
					bx (* ax (mai_dxf 40 en))
					ra (angle '(0.0 0.0) p1)
					mt (list (list (cos ra) (- (sin ra))) (list (sin ra) (cos ra)))
				)
				(mapcar
					'(lambda ( u ) (trans (mapcar '+ cn (mai_mxv mt (list (* ax (cos u)) (* bx (sin u))))) zv 0))
					(list
						(mai_dxf 41 en)
						(mai_dxf 42 en)
					)
				)
			)
		)
	)
	(if (minusp bu) (reverse pl) pl)
)

	(setq
		enx (entget ent)
		ocs (mai_dxf 210 enx)
		cls (= 1 (logand 1 (mai_dxf 70 enx)))
		lst (LM:LWVertices enx)
	)
	(foreach grp
		(setq lst
			(apply
				'mapcar
				(cons 'list
					(mapcar
						(function
							(lambda ( a b / bu ew p1 p2 sw )
							(princ "\naaa")
								(setq
									p1 (mai_dxf 10 a)
									p2 (mai_dxf 10 b)
									sw (/ (mai_dxf 40 a) 2.0)
									ew (/ (mai_dxf 41 a) 2.0)
									bu (mai_dxf 42 a)
								)
							(princ "\nbbb")
								(mapcar
									(function
										(lambda ( fn / a1 cn el i1 i2 nm pl rd v1 w1 )
											(cons
												(cond
													(	(mai_equal 0.0 bu)
														(setq
															v1 (mapcar '- p1 p2)
															v1 (list (- (cadr v1)) (car v1))
															nm (distance '(0.0 0.0) v1)
														)
							(princ "\nccc")
														(if (mai_equal 0.0 nm)
															(setq v1 '(0.0 0.0))
															(setq v1  (mapcar '/ v1 (list nm nm)))
														)
							(princ "\nddd")
														(entmakex
															(list
																'(0 . "LINE")
																(cons 10 (trans (mapcar 'fn p1 (mai_v_scale v1 sw)) ocs 0))
																(cons 11 (trans (mapcar 'fn p2 (mai_v_scale v1 ew)) ocs 0))
															)
														)
													)
													(	(mai_equal sw ew)
														(mapcar 'set '(cn rd) (mai_data_pline2arc (list p1 p2 bu)))
							(princ "\neee")
														(entmakex
															(list
																'(0 . "ARC")
																(cons 010 cn)
																(cons 040 (fn rd (if (minusp bu) (- sw) sw)))
																(cons 050 (if (minusp bu) (angle cn p2) (angle cn p1)))
																(cons 051 (if (minusp bu) (angle cn p1) (angle cn p2)))
																(cons 210 ocs)
															)
														)
							(princ "\nfff")
													)
													(	t
														(mapcar 'set '(cn rd) (mai_data_pline2arc (list p1 p2 bu)))
							(princ "\nggg")
														(setq
															i1 (atan bu)
															i2 (/ (- ew sw) (if (minusp bu) -4.0 4.0))
															a1 (angle cn p1)
															w1 (fn rd (if (minusp bu) (- sw) sw))
														)
							(princ "\nhhh")
														(repeat 5
															(setq
																pl (cons (polar cn a1 w1) pl)
																a1 (+  a1 i1)
																w1 (fn w1 i2)
															)
														)
														(if (= 1 (apply 'mai_point_Clockwise (cddr pl)))
															(setq pl (reverse pl))
														)
							(princ "\niii")
														(if (setq el (apply 'mai_Ellipse_5P pl))
															(entmakex
														(setq nnn
																(list
																	(cons 000 "ELLIPSE")
																	(cons 100 "AcDbEntity")
																	(cons 100 "AcDbEllipse")
																	(cons 10 (trans (car el) ocs 0)) ;; WCS Ellipse Center
																	(cons 11 (trans (cadr el) ocs 0)) ;; WCS Major Axis Endpoint from Center
																	(cons 40 (caddr el)) ;; minor/major ratio
																	(cons 041 (cadddr el))
																	(cons 042 (nth 4 el))
																	(cons 210 ocs)
																)
															)
															)
														)
																					(princ "\njjj")

													)
												)
												(list p1 p2 sw ew bu)
											)
										)
									)
									(list + -)
								)
							)
						)
						lst
						(if cls
							(append (cdr lst) (list (car lst)))
							(cdr lst)
						)
					)
				)
			)
		)
		(mapcar
			(function
				(lambda ( a b / e1 e2 ip p1 p2 q1 q2 )
					(cond
						(	(or (null (car a)) (null (car b))))

						(	(and
								(mai_equal 0 (last a))
								(mai_equal 0 (last b))
							)
							(setq
								e1 (entget (car a))
								e2 (entget (car b))
								p1 (mai_dxf 10 e1)
								p2 (mai_dxf 11 e1)
								q1 (mai_dxf 10 e2)
								q2 (mai_dxf 11 e2)
							)
							(cond
								(	(mai_equal
										(mai_v_Unit (mapcar '- (caddr a) (cadr a)))
										(mai_v_Unit (mapcar '- (caddr b) (cadr b)))
									)
									(or (mai_equal p2 q1)
										(entmake (list '(0 . "LINE") (cons 10 p2) (cons 11 q1)))
									)
								)

								(	(setq ip (inters p1 p2 q1 q2 nil))
									(entmod (subst (cons 11 ip) (assoc 11 e1) e1))
									(entmod (subst (cons 10 ip) (assoc 10 e2) e2))
								)
							)
						)

						(	(not (mai_equal (car (cddddr a)) (cadddr b)))
							(entmake
								(list
									'(0 . "LINE")
									(cons 10 (cadr (_endpoints (car a) (last a))))
									(cons 11 (car  (_endpoints (car b) (last b))))
								)
							)
						)
					)
				)
			)
			grp
			(if cls
				(append (cdr grp) (list (car grp)))
				(cdr grp)
			)
		)
	)
	(if (not cls)
		(foreach f (list car cadr)
			(and
				(caaar lst)
				(caaadr lst)
				(setq ep1 (f (_endpoints (caaar  lst) (last (caar  lst)))))
				(setq ep2 (f (_endpoints (caaadr lst) (last (caadr lst)))))
				(not (mai_equal ep1 ep2))
				(mai_entmake (list '(0 . "LINE") (cons 10 ep1) (cons 11 ep2)))
			)
			(setq lst (mapcar 'reverse lst))
		)
	)
	(princ)
)


;; Point -> Ellipse Parameter  -  Lee Mac
;; Returns the elliptical arc parameter value for the given point
;; dxf  - [lst] Ellipse DXF data (DXF groups 10, 11 & 40)
;; pt   - [lst] Point on Ellipse

(defun LM:point->param ( dxf pt / a m r u x y )
	(setq
		m (cadr dxf)
		a (distance '(0.0 0.0) m)
		r (angle '(0.0 0.0) m)
	)
	(mapcar
		'set
		'(x y)
		(mai_mxv
			(list (list (cos r) (sin r)) (list (- (sin r)) (cos r)))
			(mapcar '- pt (car dxf))
		)
	)
	(setq u (mai_arccos (/ x a)))
	(if (< y 0)
		(setq u (- (+ pi pi) u))
	)
	(rem (+ pi pi u) (+ pi pi))
)

;; LW Vertices  -  Lee Mac
;; Returns a list of lists in which each sublist describes
;; the position, starting width, ending width and bulge of the
;; vertex of a supplied LWPolyline

(defun LM:LWVertices ( e )
	(if (setq e (member (assoc 10 e) e))
		(cons
			(list
				(assoc 10 e)
				(assoc 40 e)
				(assoc 41 e)
				(assoc 42 e)
			)
			(LM:LWVertices (cdr e))
		)
	)
)


;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg params / sel )
	(princ msg)
	(setvar 'nomutt 1)
	(setq sel (vl-catch-all-apply 'ssget params))
	(setvar 'nomutt 0)
	(if (not (vl-catch-all-error-p sel)) sel)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
	(LM:endundo doc)
	(vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
	(while (= 8 (logand 8 (getvar 'undoctl)))
		(vla-endundomark doc)
	)
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
	(eval (list 'defun 'LM:acdoc 'nil (vlax-get (vlax-get-acad-object) 'activedocument)))
	(LM:acdoc)
)

(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;