在中间距离画线
大家好，新年快乐我的请求是autolisp routin，它可以从两条现有直线创建一条直线，可以平行也可以不平行，并且该直线的每个点与两条直线的距离相同
谢谢 这没有错误检查，但这是一个开始
丹
(defun c:test ( / activedocument ename1 ename2 iacadapplication modelspace mp1 mp2 object1 object2)
(setq IAcadApplication (vlax-get-acad-object)
ActiveDocument (vla-get-ActiveDocument IAcadApplication)
ModelSpace (vla-get-ModelSpace ActiveDocument)
EName1 (car (entsel "\nSelect the first line: "))
EName2 (car (entsel "\nSelect the Second line: "))
object1 (vlax-ename->vla-object EName1)
object2 (vlax-ename->vla-object EName2)
mp(lambda (p1 p2) (mapcar (function(lambda(a b)(/(+ a b 0.0) 2.0))) p1 p2))
mp1 (mp (vlax-get object1 'StartPoint) (vlax-get object1 'EndPoint))
mp2 (mp (vlax-get object2 'StartPoint) (vlax-get object2 'EndPoint))
)
(vla-AddLine ModelSpace (vlax-3d-point mp1) (vlax-3d-point mp2))
(princ)
)
这是我的两分钱
(defun C:MLL (/ *error* acsp adoc dlt1 dlt2 ep1
ep2 flag int1 int2 ip line1 line2 nxp ocirc
p1 p2 rad sp1 sp2 ss tmp x
xline1
)
(if (< (atoi (substr (getvar "acadver") 1 2)) 15)
(progn
(alert
"Programm wiil be works in\n
AutoCAD 2000 and higher versions"
)
(exit)
(princ)
)
)
(or (vl-load-com))
;=====================================;
(defun *error* (msg)
(princ msg)
(vla-endundomark
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(princ)
)
(defun midpoint (p1 p2)
(mapcar (function (lambda (a b)
(* (+ a b) 0.5)
)
)
p1
p2
)
)
;=====================================;
(defun group-by-num (lst num / ls ret)
(if (= (rem (length lst) num) 0)
(progn
(setq ls nil)
(repeat (/ (length lst) num)
(repeat num
(setq ls
(cons (car lst) ls)
lst (cdr lst)
)
)
(setq ret (append ret (list (reverse ls)))
lsnil
)
)
)
)
ret
)
;=====================================;
(or adoc
(setq adoc (vla-get-activedocument
(vlax-get-acad-object)
)
)
)
(or acsp
(setq acsp (if (= (getvar "CVPORT") 1)
(vla-get-paperspace
adoc
)
(vla-get-modelspace
adoc
)
)
)
)
(vla-endundomark
adoc
)
(vla-startundomark
adoc
)
(setq ss (ssget (list (cons 0 "LINE"))))
(if (/= (sslength ss) 2)
(progn
(alert "Must be selected 2 lines only")
(exit)
(princ)
)
)
(setq line1 (vlax-ename->vla-object (ssname ss 0))
line2 (vlax-ename->vla-object (ssname ss 1))
sp1 (vlax-get line1 'StartPoint)
ep1 (vlax-get line1 'EndPoint)
sp2 (vlax-get line2 'StartPoint)
ep2 (vlax-get line2 'EndPoint)
dlt1(vlax-get line1 'Angle)
dlt2(vlax-get line2 'Angle)
)
(if (or (equal dlt1 dlt2 1e-08)
(equal dlt1 (+ pi dlt2) 1e-08)
) ;parallel lines
(setq flag t)
(setq flag nil)
)
(if flag
(progn
(if
(< (distance sp1 sp2) (distance sp1 ep2))
(progn
(setq p1 (midpoint sp1 sp2)
p2 (midpoint ep1 ep2)
)
)
(progn
(setq p1 (midpoint sp1 ep2)
p2 (midpoint ep1 sp2)
)
)
)
(setq xline1 (vlax-invoke acsp 'AddXline p1 p2))
)
(progn
(setq tmp (vlax-invoke line1 'Intersectwith line2 acextendboth))
(setq rad (distance tmp
(setq p1
(car (vl-sort
(list sp1 sp2 ep1 ep2)
(function (lambda (a b)
(< (distance tmp a) (distance tmp b))
)
)
)
)
)
)
)
(if (vl-some (function (lambda (a)
(equal tmp a 1e-08)
)
)
(list sp1 sp2 ep1 ep2)
)
(setq rad 0.001)
)
(setq ocirc (vlax-invoke acsp 'AddCircle tmp rad))
(setq int1 (group-by-num
(vlax-invoke ocirc 'Intersectwith line1 acextendnone)
3
)
int2 (group-by-num
(vlax-invoke ocirc 'Intersectwith line2 acextendnone)
3
)
)
(setq
nxp (vl-remove-if (function not)(vl-sort (append int1 int2)
(function (lambda (a b)
(< (distance sp1 a) (distance sp1 b))
)
)
)
)
)
(if (= (length nxp) 1)
(progn
(if int1
(setq ip (polar tmp (angle tmp (vlax-get line2 'StartPoint))
(distance tmp int1)))
(setq ip (polar tmp (angle tmp (vlax-get line1 'StartPoint))
(distance tmp int2)))
)
(setq p2 (midpoint (car nxp) ip))
)
(setq p2 (midpoint (car nxp) (cadr nxp)))
)
(setq xline1 (vlax-invoke acsp 'AddXline tmp p2))
)
)
(mapcar (function (lambda (x)
(vl-catch-all-apply
(function (lambda ()
(progn
(vla-delete ocirc)
(vlax-release-object x)
)
)
)
)
)
)
(list line1 line2 ocirc xline1)
)
(*error* nil)
(princ)
)
~'J'~ 美好的
只是想一想，您可能需要检查选择集（ss）的长度，以验证确实有两行
丹
我同意你的意见
很好的观点
~'J'~ 当两个原始长度不同时，求端点平均值以生成等距线的方法会产生奇数结果。尤其是当它们相交时（见下文）。平分线可能（也可能不是）是OP要求的。
我不懂Lisp，所以我的贡献是VBA。与通常的演示例程一样，存在有限的错误检查。此外，这也不能容纳平行线。
Sub BisectorLine()
Dim entTemp As AcadEntity
Dim entLine1 As AcadLine
Dim entLine2 As AcadLine
Dim entCircle As AcadCircle
Dim entBisector As AcadXline
Dim varTempPoint As Variant
Dim varTempPoint2 As Variant
Dim arrDblPT(2) As Double
ThisDrawing.Utility.GetEntity entTemp, varTempPoint, "Select first line: "
If Not entTemp.ObjectName = "AcDbLine" Then Exit Sub
Set entLine1 = entTemp.Copy
ThisDrawing.Utility.GetEntity entTemp, varTempPoint, "Select second line: "
If Not entTemp.ObjectName = "AcDbLine" Then Exit Sub
Set entLine2 = entTemp.Copy
varTempPoint = entLine1.IntersectWith(entLine2, acExtendBoth)
entLine1.StartPoint = varTempPoint
entLine2.StartPoint = varTempPoint
Set entCircle = ThisDrawing.ModelSpace.AddCircle(varTempPoint, 1) 'this demo for limited scale modelspace only
varTempPoint = entCircle.IntersectWith(entLine1, acExtendNone)
varTempPoint2 = entCircle.IntersectWith(entLine2, acExtendNone)
arrDblPT(0) = (varTempPoint(0) + varTempPoint2(0)) / 2
arrDblPT(1) = (varTempPoint(1) + varTempPoint2(1)) / 2
arrDblPT(2) = 0 'this demo for WCS only
Set entBisector = ThisDrawing.ModelSpace.AddXline(entCircle.Center, arrDblPT)
entLine1.Delete
entLine2.Delete
entCircle.Delete
Set entLine1 = Nothing
Set entLine2 = Nothing
Set entCircle = Nothing
Set entBisector = Nothing
End Sub
谢谢你，我的目标是得到2条线的中心线
我试着在直线平行的情况下进行布线，但如果不平行，结果就不好，因为如果我们取结果线的一个点，测量到两条线的椭圆距离，它给出了不同的测量值，所以我认为我们必须将平分线排序为SEANT说抱歉，我无法理解vb
谢谢 你试过我的吗？
谢谢
编辑：哎呀，对不起，我认为我没有正确理解这个问题
丹 谢谢Danielm103，我试了一下你的路线，但它不起作用，因为我想它画一条从第一条线的中点到第二条线的中点的线。我的要求是找到一条线，从它的每一点到这两条线的距离相等
谢谢你的努力，等待回应 对不起，我帮不了你做Lisp程序的练习。
但是，普通autocad提供了一个自动化程度不高的过程。
页:
[1]
2