根据选取曲线生成同长度Line，恳求出手相助！

wangxf888

   具体要求同图片所示，恳求大家帮忙解决下！感谢！！

言社长

2. (defun C:TT (/ CURVE TLEN SS N SUMLEN pt1 pt2)
   
3.   (vl-load-com)
   
4.   (setq SUMLEN 0)
   
5.   (setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
   
6.   (setq N 0)
   
7.   (repeat (sslength SS)
   
8.     (setq CURVE (vlax-ename->vla-object (ssname SS N)))
   
9.     (setq TLEN (vlax-curve-getdistatparam
   
10. CURVE
    
11. (vlax-curve-getendparam CURVE)
    
12.        )
    
13.     )
    
14.     (setq SUMLEN (+ SUMLEN TLEN))
    
15.     (setq N (1+ N))
    
16.   )
    
17.         (setq pt1 (getpoint "\n指定直线起点:")
    
18.               pt2 (list (+ (car pt1) SUMLEN) (cadr pt1)))
    
19.         (command "_.line" pt1 pt2 "")
    
20.   (princ "\n总长度===============================                                 【  " )
    
21.         (princ (rtos SUMLEN 2 3)) (princ "  】")
    
22.   (princ)
    
23. )

(defun C:TT (/ CURVE TLEN SS N SUMLEN pt1 pt2) <br />   (vl-load-com) <br />   (setq SUMLEN 0) <br />   (setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))<br />   (setq N 0) <br />   (repeat (sslength SS) <br />     (setq CURVE (vlax-ename->vla-object (ssname SS N))) <br />     (setq TLEN (vlax-curve-getdistatparam <br /> CURVE <br /> (vlax-curve-getendparam CURVE) <br />        ) <br />     ) <br />     (setq SUMLEN (+ SUMLEN TLEN)) <br />     (setq N (1+ N)) <br />   )<br />         (setq pt1 (getpoint "\n指定直线起点:")<br />               pt2 (list (+ (car pt1) SUMLEN) (cadr pt1)))<br />         (command "_.line" pt1 pt2 "")<br />   (princ "\n总长度===============================                                 【  " )<br />         (princ (rtos SUMLEN 2 3)) (princ "  】")<br />   (princ) <br /> )

caoyin

(defun C:TEST (/ E PP)
  (while
    (not (and
           (setq E (entsel "\n选择曲线: "))
           (progn
             (setq E  (car E)
                   PP (vl-catch-all-apply 'vlax-curve-getEndParam (list E))
             )
             (if (vl-catch-all-error-p PP)
               (not (princ "无效的对象。"))
               T
             )
           )
         )
    )
  )
  (if (setq P (getpoint "\n指定直线放置点: "))
    (entmake (list '(0 . "LINE")
                   (cons 10 (setq P (trans P 1 0)))
                   (cons 11 (cons (+ (vlax-curve-getDistAtParam E PP) (car P))
                                  (cdr P)
                             )
                   )
             )
    )
  )
  (princ)
)

wangxf888

刚回家上网看到二位的热心回复，感谢caoyin版  感谢言社长老师，都挺好用，完全预期。再次感谢！！！
把言社长老师设为最佳答案，caoyin版没意见吧！

wangxf888

wangxf888 发表于 2021-3-13 20:57
刚回家上网看到二位的热心回复，感谢caoyin版  感谢言社长老师，都挺好用，完全预期。再次感谢！！！
把言 ...