两个相交点之间的距离

pontifex · 发表于 2022-7-6 11:14:32

你好
我在任何地方都找不到，所以我正在发布新的帖子。有没有人遇到过这种Lisp程序的情况：
我有3条线，其中2条相互平行，第三条线与这两条线相交（每一条线在一个随机的焦点中），现在，当我单击相交线（两个交点之间）上的任何位置时，我的动作会导致在这两个交点之间放置一个平行于相交线的文字/多行文字，并具有这两个交点之间的距离值。
对不起，如果我的解释不够清楚，但英语不是我的第一语言
提前感谢您的帮助

BearDyugin · 发表于 2022-7-6 11:20:53

为什么不使用标准工具AutoSAD？
_dimaligned（平行尺寸），如果您只需要文字调整样式，已抑制所有线条和箭头，仅保留文字

pontifex · 发表于 2022-7-6 11:22:08

问题是我有将近100个（甚至更多）这样的交叉点（这是一个地面剖面和一个沿路有声屏的剖面。屏幕的柱子彼此之间的距离约为4-5米（这是我的相交线-柱子轴）。我一直在使用标准的cad工具，但我认为点击一次总比点击三次来实现相同的目标要好

Lee Mac · 发表于 2022-7-6 11:26:42

试一试：

对于交叉口数大于2的情况，并非100%万无一失。

李

Lee Mac · 发表于 2022-7-6 11:28:19

实际上，这样更好，选择要测量的交点之间的曲线对象。

对于非线性对象，距离测量为该对象在点之间穿过的路径，而不是直线距离。

copy


(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