最近的点形式 mtext 到 pline，但水平
我已经尝试过各种路线复杂的路由程序，但现在即使在你的帮助下我也很难弄清楚。以为我会从更简单的事情开始。假设我们有很多垂直或倾斜的折线，包括多行文字。我希望 lisp 找到与最近的左右折线的交点，但只能在水平线上，并将这些点命名为左折线的“mtext + l1”和右折线的“mtext + r1”。
很高兴看到任何帮助，尤其是在水平搜索最近的点时。
下面是图片中问题的描述。
起始情况：
运行 lisp 后以红色创建点：
绘制一条水平 XLine，查看它与多段线相交的位置，现在寻找那些与多段线相交点的最接近的 X 值。
删除临时 XLINE。
(vl-load-com)
;;
;; draw a XLINE
(defun drawxLine (pt vec)
(entmakex (list (cons 0 "XLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbXline")
(cons 10 pt)
(cons 11 vec))))
;; draw MText
(defun drawM-Text (pt str)
(entmakex (list (cons 0 "MTEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(cons 10 pt)
(cons 1 str))))
(defun drawLine (p1 p2)
(entmakex (list (cons 0 "LINE")
(cons 10 p1)
(cons 11 p2))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Intersections-Lee Mac
;;
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - VLA-Objects
;; mod - acextendoption enum of intersectwith method
;; acextendnone Do not extend either object
;; acextendthisentity Extend obj1 to meet obj2
;; acextendotherentity Extend obj2 to meet obj1
;; acextendboth Extend both objects
(defun LM:intersections ( ob1 ob2 mod / lst rtn )
(if (and (vlax-method-applicable-p ob1 'intersectwith)
(vlax-method-applicable-p ob2 'intersectwith)
(setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
)
(repeat (/ (length lst) 3)
(setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
lst (cdddr lst)
)
)
)
(reverse rtn)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:npp ( / txt plines xline pt obj2 ins insx insx_sorted xl xr str)
(princ "\nSelect ploylines")
(setq plines (ssget (list (cons 0 "LINE,LWPOLYLINE,POLYLINE"))))
(setq txt (entsel "\nSelect Text object: "))
(setq str (cdr (assoc 1 (entget (car txt)))))
(setq pt(cdr (assoc 10 (entget (car txt)))))
;; draw a horizontal XLINE
(setq xline (drawxLine pt (list 1.0 0.0)));; (list 1.0 0.0) draws to the right, (list 0.0 1.0) draws up thus vertical, ...
;; now look for intersect points of the XLINE with the polylines
(setq insx (list)) ;; list of intersect points.Only the X value.
(setq i 0)
(repeat (sslength plines)
(setq obj2 (ssname plines i))
(setq ins (LM:intersections (vlax-ename->vla-object xline) (vlax-ename->vla-object obj2) acextendnone))
;; if there are intersect points, add the x-value to the list
(foreach a ins
(setq insx (append insx (list (nth 0 a) )))
)
(setq i (+ i 1))
)
;; we no longer need the XLINE, we delete it
(entdel xline)
;; sort the insx values from left to right
(setq insx_sorted (vl-sort insx '<))
;;(princ insx_sorted)
;; now we go looking for xl (left of the text) and xr (right of the text)
(setq xl nil)
(setq xr nil)
(foreach a insx_sorted
(if (< a (nth 0 pt)) ;; as long as the insert point is to the left, we'll replace xl
(setq xl a)
)
(if (and (not xr) (> a (nth 0 pt))) ;; the first insert point the right is the closest one
(setq xr a)
)
)
;;(princ "\nLeft: ")
;;(princ xl)
;;(princ " - Right: ")
;;(princ xr)
;;(princ )
;; draw line
;; we add the Y value of the Text object to get a point
(drawLine (list xl (nth 1 pt)) (list xr (nth 1 pt)))
;; draw Mtexts
(drawM-Text (list xl (nth 1 pt)) (strcat str " l1"))
(drawM-Text (list xr (nth 1 pt)) (strcat str " r1"))
)
页:
[1]