希望大神帮改个画单线管

qssq

在明经论坛经常有些连续画弯头的程序效果是图a，希望大神能帮添加两个功能（1）可以自定义多段线的宽度（2）在弯头处加两条短线短线（长度为线宽的5倍，如图b所示。

qssq

论坛有个画连续弯头的程序：http://bbs.mjtd.com/thread-93655-3-1.html

qssq

这个程序也能实现图a的效果
(defun err (s)
   (if (and (/= s "console break")
      (/= s "Function cancelled")
      (/= s "quit/exit abort")
    )
  (progn
    (setvar "osmode" oldos)     
    (setvar "autosnap" oldosn)
    (setvar "orthomode" oldor)
    (setq *error* olderr)
    (command "_.undo" "e")
     (setvar "cmdecho" oldcmd)
    (princ (strcat "\n程序出错或用户退出:" s))
  )
   )
)
;;;备份系统变量
(defun bak ()
   (setq        oldcmd        (getvar "cmdecho"))
   (setvar "cmdecho" 0)
   (command "_.undo" "be")
   (setq        oldos        (getvar "osmode")
   oldosn (getvar "autosnap")
   oldor (getvar "orthomode")        
   olderr        *error*
   *error*        err
   )
)
;;恢复系统变量
(defun rebak ()
   (setvar "osmode" oldos)  
   (setvar "autosnap" oldosn)
   (setvar "orthomode" oldor)
   (setq *error* olderr)
   (command "_.undo" "e")
   (setvar "cmdecho" oldcmd)
)
;求交点集函数－nth
;;经过测试，nth函数仅比assoc函数快一点点。
;;故此函数也可取消i，j变量，直接使用assoc函数
(defun ssinter (el / el1 obj1 obj2 ipts pts list1 outlst i j)
   (setq outlst (mapcar 'list el)
  i      -1   ;obj1位置指针
  n      0   ;交点数计数器
   )
   (while el
  (setq obj1 (car el)
    list1 (nth (setq i (1+ i)) outlst) ;obj1已有的交点列表
    el (cdr el)
    el1 el
    j i   ;obj2位置指针
  )
  (while el1
    (setq obj2 (car el1)
   el1  (cdr el1)
   j  (1+ j)
    )
    ;;取交点
    (if (and (setq ipts (vla-intersectwith obj1 obj2 0))
   (setq ipts (vlax-variant-value ipts))
   (> (vlax-safearray-get-u-bound ipts 1) 0)
    )
  (progn
    (setq ipts (vlax-safearray->list ipts)
   pts  '()  ;obj1,obj2交点临时列表变量
    )
    (while (> (length ipts) 0)
   (setq pts  (cons (list (car ipts)
     (cadr ipts)
     (caddr ipts)
   )
   pts
    )
  ipts (cdddr ipts)
   )
    )
    (setq list1 (append list1 pts) ;存obj1交点表，循环结束后再更新
   n     (+ n (length pts)) ;交点计数累加
    )
    ;;obj2的交点列表立即更新
    (setq
   outlst (subst (append (nth j outlst) pts)
   (nth j outlst)
   outlst
   )
    )
  )
    )
  )
;|   ;;当obj1存在交点，且非封闭曲线，添加两端点
  (if (and (cdr list1) (not (vlax-curve-isClosed obj1)))
    (setq list1 (append list1
   (list (vlax-curve-getEndPoint obj1))
   (list (vlax-curve-getStartPoint obj1))
  )
    )
  )
  (setq outlst (subst list1 (nth i outlst) outlst)) ;更新obj1交点列表 |;
   )
   outlst
)
;;点集排序及删除重复点函数
(defun InterSort (el / obj1 pts plst outlst)
   (setq outlst '())   ;empty list
   (foreach item el
  (setq obj1 (car item)
    pts  (cdr item)
    plst '()   ;empty list
  )
  (if pts    ;若无交点，则不修改该实体
    (progn
  ;;交点排序，列表为逆序
  (setq
    pts (vl-sort
   pts
   (function (lambda (p1 p2)
     (< (vlax-curve-getParamAtPoint obj1 p1)
     (vlax-curve-getParamAtPoint obj1 p2)
     )
   )
   )
     )
  )
  ;;剔除重复点并将列表顺序转正
  (foreach p pts
    (if plst
   (if (not (equal p (car plst) 0.00001))
     (setq plst (cons p plst))
   )
   (setq plst (cons p plst))
    )
  )
  ;;闭合曲线需再添加首个交点以使新实体完全封闭
  (if (vlax-curve-isClosed obj1)
    (setq plst (cons (last plst) plst))
  )
  (setq plst   (cons (vlax-vla-object->ename obj1) plst)
     outlst (cons plst outlst)
  )
    )
  )
   )
   outlst
)
;;计算耗时
(defun xdl-getutime ()
   (* 86400 (getvar "tdusrtimer"))
)
;; 清理当前选择集
(defun Clearcset (/ cset)
  (if (not (vl-catch-all-error-p     
  (setq cset (vl-catch-all-apply 'vla-item (list(vlax-get-property (vlax-get-property (vlax-get-acad-object) 'activedocument ) 'selectionsets)"CURRENT")))
      )      
    )   
  (vla-delete cset)  
  )
  (princ)
  )
  
(defun c:xlx( / elist ssg n t0)
   (VL-LOAD-COM)
   (setq pt_list1 '())
   (setq r (getreal (strcat "请输入倒角半径<" (rtos (getvar "filletrad"))
         ">"
        )
      )
   )
   (if (null r)
    (setq r (getvar "filletrad"))
    (setvar "filletrad" r)
  )
  ;(setq ss (ssget '((0 . "line"))))
  (bak)
  (clearcset)
  (if (setq ssg (ssget '((0 . "line"))))
    (vlax-for obj (vla-get-activeselectionset
      (vla-get-activedocument (vlax-get-acad-object))
    )
      (setq elist (cons obj elist)) ; ssg->elist
    )
(vlax-release-object obj)
  )
  (setq t0 (xdl-getutime))
  (setq pt_list(InterSort (ssinter elist)))
  (foreach pt pt_list
  (setq pt_list1 (append (cdr pt)pt_list1))
  )
  (foreach pt pt_list1
  ;(setq pt (cadr pt))
    (progn
      (setq ss2 (ssget "c" pt pt))
        (setq en1 (ssname ss2 0))
    (setq en2 (ssname ss2 1))
        (if (and en1 en2)(command "fillet" en1 en2))
      )
    )
(rebak)
(princ (strcat "\n*****找到交点"
   (itoa n)
   "个，交点倒角操作操作共耗时"
   (rtos (- (xdl-getutime) t0) 2 3)
   "秒。*****"
  )
  )
  (princ)
  (prompt "<<xlx>>相连线批量倒角")
  )
  (prompt "<<xlx>>相连线批量倒角")
  (princ)