[Publipor]

Добрый день.
Подскажите пожалуйста как сделать данную мультивыноску. А именно, при добавлении новой выноски, она добавлялась уже с другой вершины.
Заранее спасибо.

[Vladimir_Sergeevich]

возможно так

Код:

[Выделить все]

 (defun c:ml-cont ( / obj)
	(setq obj (car (entsel)))
	(if 
		(and
			(not (null obj))
			(= (vla-get-ObjectName (vlax-ename->vla-object obj)) "AcDbMLeader")
		)
		(if (ml-continous  (vlax-ename->vla-object obj)) t (princ "Break"))
		(princ "\nIncorrect input") 
	)
	(princ)
)

(defun ml-continous (mlObj  / temp newLead mlBasePt newLead newIndex fl) ;|двигаем выноску
	*аргумент - vla-object мультивыноски
	*возвращет - vla-object мультивыноски или nil при нажатии esc
	|;
	(defun 3ptVariant (pt1 pt2 pt3 /  ) 
	;;;input - 2 points
	;;;output - vla-variant
		(vlax-make-variant
			(vlax-safearray-fill 
				(vlax-make-safearray 
					vlax-vbDouble 
					'(0 . 8) 
				) 
				(append pt1 pt2 pt3)
			) 	
		) 
	)
	(setq 
		temp (vlax-safearray->list (vlax-variant-value (vla-GetLeaderLineVertices mlObj 0)))
		mlBasePt (list (car temp) (cadr temp) (caddr temp))
		fl t
		newLead (vla-AddLeaderLine mlObj 0 (3ptVariant '(0 0 0) '(1 1 1) mlBasePt)  )
		newIndex (last (vlax-safearray->list (vlax-variant-value (vla-GetLeaderLineIndexes mlObj 0))))
	)
	(while fl
		(if (vl-catch-all-error-p (setq temp (vl-catch-all-apply 'grread '(t 12 0))))
			(progn ;;ESC
				(vla-RemoveLeaderLine mlObj newIndex)
				(setq fl nil mlObj nil)
			) 
			(progn 
				(if (or (= (car temp) 5) (= (car temp) 3)) 
					(progn
						(setq 
							pt1 (trans (cadr temp) 1 0)
							pt2 (sad-get-intersect-line mlBasePt (polar mlBasePt 0 100) pt1 (polar pt1 (* pi -0.75) 100))
						)
						(vla-SetLeaderLineVertices mlObj newIndex (3ptVariant pt1 pt2 mlBasePt))
				))
				(if (or (= (car temp) 3) (= (car temp) 25)) (setq fl nil))
			)
		)
	) ;;while
	mlObj
)

(defun sad-get-intersect-line (pt1 pt2 pt3 pt4 / ) ;|точка пересечения двух отрезков определенных точками
	Intput 4 point determed 2 line
	Return intesect point or nil if lines is parralel
	|;
	(defun fun-line (p1 p2 / )  ;;return list ( A В C ) Ax+Bx+C=0
		(list  
			(- (cadr p1) (cadr p2))
			(- (car p2) (car p1))
			(- (* (car p1) (cadr p2)) (* (car p2) (cadr p1)))
		)
	)
	(defun intersect-line ( ABC1 ABC2 / pt x) ;;return Point
	;;A1 not zero! horizontal line
		(if (zerop (car ABC1)) 	(setq pt ABC1 ABC1 ABC2 ABC2 pt pt nil) )
		(if (or
				(and (= (car ABC1) (car ABC2)) (= (cadr ABC1) (cadr ABC2)))
				(and (= (car ABC1) (- 0 (car ABC2))) (= (cadr ABC1) (- 0 (cadr ABC2))))	
			)
			(progn (princ "\nLine iz not intersect ") nil)
			(progn
				(setq 
					y (/(- (/ (* (car ABC2) (caddr ABC1)) (car ABC1)) (caddr ABC2)) (- (cadr ABC2) (/ (* (car ABC2) (cadr ABC1)) (car ABC1))))
					x (/ (- 0 (* (cadr ABC1) y) (caddr ABC1)) (car ABC1) )
					pt (list x y 0)
				)
			)
		)
	)	
	(intersect-line (fun-line pt1 pt2) (fun-line pt3 pt4))
)

Работать будет только в горизонтальном положении (как в примере), коли надо, другие углы сами дописывайте.
Offtop: Что угодно, лишь бы не работать...