两个相交点之间的距离
你好我在任何地方都找不到，所以我正在发布新的帖子。有没有人遇到过这种Lisp程序的情况：
我有3条线，其中2条相互平行，第三条线与这两条线相交（每一条线在一个随机的焦点中），现在，当我单击相交线（两个交点之间）上的任何位置时，我的动作会导致在这两个交点之间放置一个平行于相交线的文字/多行文字，并具有这两个交点之间的距离值。
对不起，如果我的解释不够清楚，但英语不是我的第一语言
提前感谢您的帮助 为什么不使用标准工具AutoSAD？
_dimaligned（平行尺寸），如果您只需要文字调整样式，已抑制所有线条和箭头，仅保留文字 问题是我有将近100个（甚至更多）这样的交叉点（这是一个地面剖面和一个沿路有声屏的剖面。屏幕的柱子彼此之间的距离约为4-5米（这是我的相交线-柱子轴）。我一直在使用标准的cad工具，但我认为点击一次总比点击三次来实现相同的目标要好 试一试：
对于交叉口数大于2的情况，并非100%万无一失。
李 实际上，这样更好，选择要测量的交点之间的曲线对象。
对于非线性对象，距离测量为该对象在点之间穿过的路径，而不是直线距离。
(defun c:int_dist (/
*error*
isCurveObj ss->list
vlax-list->3D-point
SortFromPt
DIST
ENT
ILST
LANG
MA MI MPT
OBJ
PT
SS
TOBJ
UFLAG
)
(vl-load-com)
;; Lee Mac~04.03.10
(setq *doc (cond (*doc) ((vla-get-ActiveDocument
(vlax-get-acad-object)))))
(defun *error* (msg)
(and uFlag (vla-EndUndoMark *doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
) ;_or
(princ)
) ;_defun
(defun isCurveObj (ent)
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function
vlax-curve-getEndParam
) ;_function
(list ent)
) ;_vl-catch-all-apply
) ;_vl-catch-all-error-p
) ;_not
) ;_defun
(defun ss->list (ss / i ent ObjLst)
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq ObjLst
(cons
(vlax-ename->vla-object ent)
Objlst
) ;_cons
) ;_setq
) ;_while
ObjLst
) ;_defun
(defun vlax-list->3D-point (lst)
(if lst
(cons (list (car lst) (cadr lst) (caddr lst))
(vlax-list->3D-point (cdddr lst))
) ;_cons
) ;_if
) ;_defun
(defun SortFromPt (pt lst)
(vl-sort lst
(function
(lambda (a b)
(< (distance a pt)
(distance b pt)
) ;_<
) ;_lambda
) ;_function
) ;_vl-sort
) ;_defun
(while
(progn
(setq ent (entsel)
pt(cadr ent)
ent (car ent)
) ;_setq
(cond ((eq 'ENAME (type ent))
(if (isCurveObj ent)
(progn
(vla-getBoundingBox
(setq obj
(vlax-ename->vla-object ent)
) ;_setq
'Mi
'Ma
) ;_vla-getBoundingBox
(mapcar
(function set)
'(Mi Ma)
(mapcar
(function
vlax-safearray->list
) ;_function
(list Mi Ma)
) ;_mapcar
) ;_mapcar
(setq ss
(ssget "_C"
(list (car Mi) (cadr Ma) 0.)
(list (car Ma) (cadr Mi) 0.)
) ;_ssget
) ;_setq
(if
(and
(setq iLst
(apply
(function
append
) ;_function
(vl-remove 'nil
(mapcar
(function
(lambda (x)
(vlax-list->3D-point
(vlax-invoke
obj
'IntersectWith
x
acExtendNone
) ;_vlax-invoke
) ;_vlax-list->3D-point
) ;_lambda
) ;_function
(ss->list
(ssdel ent ss)
) ;_ss->list
) ;_mapcar
) ;_vl-remove
) ;_apply
) ;_setq
(< 1 (length iLst))
) ;_and
(progn
(setq uFlag
(not
(vla-StartUndoMark *doc)
) ;_not
) ;_setq
(setq iLst (SortFromPt
(vlax-curve-getClosestPointto ent pt)
iLst
) ;_SortFromPt
iLst (list (car iLst) (cadr iLst))
) ;_setq
(setq mPt
(vlax-curve-getPointatDist
ent
(/
(+
(vlax-curve-getDistatPoint
ent
(cadr iLst)
) ;_vlax-curve-getDistatPoint
(vlax-curve-getDistAtPoint
ent
(car ilst)
) ;_vlax-curve-getDistAtPoint
) ;_-
2.
) ;_/
) ;_vlax-curve-getPointatDist
) ;_setq
(setq dist
(abs
(-
(vlax-curve-getDistatPoint
ent
(cadr iLst)
) ;_vlax-curve-getDistatPoint
(vlax-curve-getDistAtPoint
ent
(car ilst)
) ;_vlax-curve-getDistAtPoint
) ;_-
) ;_abs
) ;_setq
(setq lAng
(angle '(0 0 0)
(vlax-curve-getFirstDeriv
ent
(vlax-curve-getParamatPoint
ent
mPt
) ;_vlax-curve-getParamatPoint
) ;_vlax-curve-getFirstDeriv
) ;_angle
) ;_setq
(cond ((and (> lAng (/ pi 2)) (<= lAng pi))
(setq lAng (- lAng pi))
)
((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
(setq lAng (+ lAng pi))
)
) ;_cond
(setq tObj
(vla-AddText
(if
(zerop
(vla-get-ActiveSpace *doc)
) ;_zerop
(if
(eq :vlax-true
(vla-get-MSpace *doc_)
) ;_eq
(vla-get-ModelSpace *doc)
(vla-get-PaperSpace *doc)
) ;_if
(vla-get-ModelSpace *doc)
) ;_if
(rtos dist)
(vlax-3D-point
'(0 0 0)
) ;_vlax-3D-point
(getvar 'TEXTSIZE)
) ;_vla-AddText
) ;_setq
(vla-put-Alignment tObj acAlignmentMiddleCenter)
(vla-put-TextAlignmentPoint
tObj
(vlax-3D-point
(polar mPt
(+ lAng (/ pi 2.))
(getvar 'TEXTSIZE)
) ;_polar
) ;_vlax-3D-point
) ;_vla-put-TextAlignmentPoint
(vla-put-rotation tObj lAng)
(setq uFlag
(vla-EndUndomark *doc)
) ;_setq
) ;_progn
(princ "\n** Object Has less than Two Intersections **")
) ;_if
) ;_progn
(princ "\n** Invalid Object Selected **")
) ;_if
)
) ;_cond
) ;_progn
) ;_while
(princ)
) ;_defun
决定更改代码格式？
这就是我之前的代码所做的。
这是当前由LUPREC Sys Var设置的，但我也可以在代码中手动更改它。
代码当前使用您的TextStyle设置，但是的，我可以更改此设置。
啊！新手失误！难怪我没有注意到！谢谢伙计
我想试试我的风格
克里给了你太多的困难眨眼：
想想你为这种风格的格式对我唠叨了多少次。
嗯，受克里言论的刺激，我想我会看看它会是什么样子——但说实话，我不喜欢这样，所以我可能会回到我以前的风格。 好的，之前的代码已更新，以反映Alan的错误点
现在试一试Pontifex
页:
[1]
2