如何将多段线按标注分割成多个小多段线？返回值为小多段线的图元名和对标的图元名

byghbcx

好复杂呀，我来个简单点的能不能符合你的要求
(defun c:daduan( / old ss ss1 en pt1 pt2 pt pt-list pts temp lst m n s s1 s2)
  (DEFUN ENT_SSINT (S1 S2 / L1 L2 S3 K E
  (DEFUN SYS_SWAP ($$P1 $$P2 / P)
  (SETQ P (EVAL $$P1))
  (SET (EVAL (quote $$P1)) (EVAL $$P2))
  (SET (EVAL (quote $$P2)) P)
  (PRINC)
  )
  (SETQ L1 (SSLENGTH S1)
        L2 (SSLENGTH S2)
  )
  (IF (> L1 L2)
    (PROGN
      (SYS_SWAP (quote S1) (quote S2))
      (SYS_SWAP (quote L1) (quote L2))
    )
  )
  (SETQ S3 (SSADD)
        K 0
  )
  (REPEAT L1
    (SETQ E (SSNAME S1 K))
    (IF (SSMEMB E S2)
      (SETQ S3 (SSADD E S3))
    )
    (SETQ K (1+ K))
  )
  (IF (= (SSLENGTH S3) 0)
    (SETQ S3 NIL)
  )
  S3
)
  (setq old (getvar "osmode"))
  (setvar "osmode" 0)
    (prompt "\n请选择尺寸对象:")
    (setq ss  (ssget '((0 . "DIMENSION"))))
    (prompt "\n请选择要处理的对象:")
    (setq ss1  (ssget '((0 . "LWPOLYLINE"))) pt-list '())
    (repeat (setq n (sslength ss))
    (setq en (ssname ss (setq n (1- n))))
    (setq pt1 (cdr (assoc 13 (entget en)))
          pt2 (cdr (assoc 14 (entget en)))
          )
      (if (not (member pt1 pt-list)) (setq pt-list (append (list pt1) pt-list)))
      (if (not (member pt2 pt-list)) (setq pt-list (append (list pt2) pt-list)))
      )
    (setq pt-list (vl-sort pt-list '(lambda (x y)
                                 (< (car x) (car y))
                               )))
    (setq pts (list (vlax-curve-getStartPoint (vlax-ename->vla-object (ssname ss1 0)))
                    (vlax-curve-getEndPoint (vlax-ename->vla-object (ssname ss1 0)))))
    (mapcar
      '(lambda(x)
         (command "line" x (polar x (/ pi 2) 10) "")
         (setq temp (entlast))
         (setq pt (vla-intersectwith  (vlax-ename->vla-object temp) (vlax-ename->vla-object (ssname ss1 0)) acExtendThisEntity))
         (setq pt (safearray-value (vlax-variant-value pt)))
         (if (and pt (not (member pt pts))) (setq pts (append (list pt) pts)))
         (command "erase" temp "")
         )
      pt-list)
    (setq pts (vl-sort pts '(lambda (x y)
                                 (< (car x) (car y))
                               )))
    (mapcar '(lambda(x)
    (setq ss2 (ssget "c" x x '((0 . "LWPOLYLINE"))))
               (command "break" (list (ssname ss2 0) x) x "")
               )
            pts)
    (setq n 0 lst '())
    (repeat (1- (length pts))
            (setq s1 (ssget "c" (nth n pts) (nth n pts) '((0 . "LWPOLYLINE"))))
            (setq s2 (ssget "c" (nth (1+ n) pts) (nth (1+ n) pts) '((0 . "LWPOLYLINE"))))
            (setq s (ENT_SSINT s1 s2))
            (repeat (setq m (sslength ss))
              (setq en (ssname ss (setq m (1- m))))
              (setq pt1 (cdr (assoc 13 (entget en)))
                    pt2 (cdr (assoc 14 (entget en)))
              )
              (if (> (car pt1) (car pt2)) (setq pt pt1 pt1 pt2 pt2 pt))
              (if (and (equal (car pt1) (car (nth n pts)) 0.0001) (equal (car pt2) (car (nth (1+ n) pts)) 0.0001))
                (setq lst (append lst (list (list (ssname s 0) en))))
                )
              )
             (setq n (1+ n))
             )
    (setq n 0)
    (mapcar '(lambda(x) (command "chprop" (car x) (cadr x) "" "c" (if (> (setq n (1+ n)) 255) (setq n 1) n) "" "")) lst)
  (setvar "osmode" old)
   lst
    )