[编程交流] 最近的点形式 mtext 到 pline，但水平

(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] VLA-Objects
;;     mod - [int] 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"))
        
)