[编程交流] 沿路径编号

(defun c:test  (  / ss path i  pt1 pt2 dist blk)
 
  (princ "\nSelect blocks: ")
  (setq ss (ssget  '((0 . "INSERT") ) ))
  (setq path (entsel  "\nSelect Path: "))
 
  (setq i 0)
  (repeat (sslength ss)
 
    (princ "\nBlock number: ")
    (princ i)
    
    (setq blk (ssname ss i))
    (setq pt1 (cdr (assoc 10 (entget blk))) )
    (princ "\nInsert point of block: ")
    (princ pt1)
    (setq pt2 (vlax-curve-getClosestPointTo (car path) pt1))
    (princ "\nClosest point to on path: ")
    (princ pt2)
    
    (setq dist (vlax-curve-getDistAtPoint (car path) pt2) )
    (princ "\nClosest distance to path: ")
    (princ (distance pt1 pt2))
    (princ "\nDistance along path: ")
    (princ dist)
    
    (princ "\n")
    (setq i (+ i 1))
    
  )  
  (princ)
)

(defun c:foo (/ a aa b c d e l ll n p pa)
  ;; RJP » 2018-10-12
  ;; Divides a polyline into segments then divides another distance at each of those
  ;; points while incrementing a number by 1. Polyline direction will dictate what
  ;; side the numbering starts on. Happy Friday!
  (cond
    ((and (setq e (car (entsel "\nPick your centerline: ")))
          (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
;;;          (setq a (getint "\nEnter number of segments to place on centerline: "))
;;;          (setq b (getdist "\nEnter length for each segment: "))
;;;          (setq c (getint "\nEnter quantity of numbers to place on each segment: "))
          ;; Testing numbers
          (setq        a 50
                b 25.
                c 5
          )
     )
     (setq d (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
     (setq n 0)
     (repeat a
       (cond
         ((setq p (vlax-curve-getpointatdist e n))
          (setq aa (angle '(0 0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))))
          (setq n (+ n (/ d (1- a))))
          (setq p (polar p (setq pa (+ aa (/ pi 2.))) (/ b 2.)))
          (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (polar p (+ pi pa) b)) '(8 . "line")))
          (setq l nil)
          (repeat c (setq l (cons p l)) (setq p (polar p (+ pi pa) (/ b (1- c)))))
          (setq ll (cons (reverse l) ll))
         )
       )
     )
     (setq n 0)
     (setq ll (reverse ll))
     (while (car ll)
       (foreach        p (mapcar 'car ll)
         (entmakex (list '(0 . "TEXT")
                         '(100 . "AcDbEntity")
                         '(67 . 0)
                         '(8 . "text")
                         '(100 . "AcDbText")
                         (cons 10 p)
                         (cons 40 (/ (/ b (1- c)) 2.))
                         (cons 1 (itoa (setq n (1+ n))))
                         '(50 . 0.0)
                         '(41 . 1.0)
                         '(51 . 0.0)
                         '(71 . 0)
                         '(72 . 1)
                         (cons 11 p)
                         '(100 . "AcDbText")
                         '(73 . 2)
                   )
         )
       )
       (setq ll (mapcar 'cdr ll))
     )
    )
  )
  (princ)
)

(defun vector (p1 p2)
    (mapcar '(lambda (%1 %2) (- %2 %1) ) p1 p2 )
)

        (if lst
            (setq lst (cons c lst))
            (setq lst (list c))
        )

6

7