;动态仿三维拉高多段线[mini_pline_extrusion].lsp

(defun c:mini_pline_extrusion ( / old_cmd old_selectioncycling massoclst pol2 bl lst1 lst2 lil p gr pp v lst2n sq2)

(defun massoclst ( key lst )
	(vl-remove-if-not '(lambda(x)(= (car x) key)) lst)
)

	(mini_start nil)
	(mai_last_com "mini_pline_extrusion")
	(setq
		lst1 (mai_select_first
				(list (cons 0 "LWPOLYLINE"))
				"选择要动态拉高的多段线:<退出>"
				"没有找到多段线."
			)
	)
	(setq old_selectioncycling (getvar "selectioncycling"))
	(if old_selectioncycling (setvar "selectioncycling" 0))
	(setq p (getpoint "\n输入拉伸点:<退出>"))
	(or p (exit))
	(setq
		sq2 (sqrt 2.0)
		lst1 (mapcar 'entget (mai_ssget_2_list lst1))
		pol2 (mapcar '(lambda(y) (entmakex (mai_assoc_remove (list -1 5 330) y))) lst1)
		bl (mapcar '(lambda(y)(massoclst 42 y)) lst1)
		lst1 (mapcar '(lambda(y)(mapcar 'cdr (massoclst 10 y))) lst1)
		lst2 lst1
		lil (mapcar
				'(lambda(c d) (mapcar '(lambda(a b) (entmakex (list '(0 . "LINE") (cons 10 a) (cons 11 b) (cons 62 1)))) c d))
				lst1
				lst2
			)
	)
	(prompt "\n移动鼠标，按 \"S\" 或 \"W\" 键缩放， 按\"A\" 或 \"D\" 旋转，按鼠标左键结束命令...")
	(while (/= 3 (car (setq gr (grread t))))
		(cond
			(	(and (= 2 (car gr)) (member (cadr gr) (list 87 119))) ;"W"
				(setq lst2n (mapcar '(lambda(y)(mapcar '(lambda(x)(mapcar '+ pp (mapcar '* (mapcar '- x pp) (list sq2 sq2)))) y)) lst2n))
			)
			(	(and (= 2 (car gr)) (member (cadr gr) (list 83 115))) ;"S"
				(setq lst2n (mapcar '(lambda(y)(mapcar '(lambda(x)(mapcar '+ pp (mapcar '* (mapcar '- x pp) (list sq2 sq2) (list 0.5 0.5)))) y)) lst2n))
			)
			(	(and (= 2 (car gr)) (member (cadr gr) (list 65 97))) ;"A"
				(setq lst2n (mapcar '(lambda(y)(mapcar '(lambda(x)(polar pp (+ (angle pp x) (/ pi 4.0)) (distance pp x))) y)) lst2n))
			)
			(	(and (= 2 (car gr)) (member (cadr gr) (list 68 100))) ;"D"
				(setq lst2n (mapcar '(lambda(y)(mapcar '(lambda(x)(polar pp (- (angle pp x) (/ pi 4.0)) (distance pp x))) y)) lst2n))
			)
			(	t
				(or pp (setq pp (cadr gr)))
				(setq
					pp (mai_grreadosnap pp)
					v (mapcar '- pp p)
				)
				(if lst2n
					(setq
						lst2n (mapcar '(lambda(y)(mapcar '(lambda(x)(mapcar '+ (mapcar '- (cadr gr) pp) x)) y)) lst2n)
						pp (cadr gr)
					)
					(setq lst2n (mapcar '(lambda(y)(mapcar '(lambda(x)(mapcar '+ v x)) y)) lst2))
				)
			)
		)
		(mapcar
			'(lambda(m n o)
				(entmod
					(apply
						'append 
						(cons
							(mai_assoc_remove (list 10 42) (entget m))
							(mapcar '(lambda(a b)(list (cons 10 a) b)) n o)
						)
					)
				)
			)
			pol2
			lst2n
			bl
		)
		(mapcar
			'(lambda(m n)
				(mapcar '(lambda(a x / y)(setq y (entget x)) (entmod (subst (cons 11 a) (assoc 11 y) y))) m n)
			)
			lst2n
			lil
		)
		(redraw)
	)
	(mai_end)
)
