各位帮我优化一下这个距形拉伸程序？谢谢！

cj52000

           大家好，从明径上找到一个距形拉伸程序，很好用，但是对于搞五金模具来讲，还不是很完善，因为工作中有很多倒角的距形，点选距形倒角一边的的线条时，出现如下图情况：


，但是我需要的是倒角和那条边一起走，如下图？






不知道我有没有表达清楚，大家都来帮我看下啊，谢谢！


源码如下：
(defun c:qstretch(/ e pt vla_e p1 plst n anglst stretchplst )
  ;;;;;;;;;;;;;;;;选边;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq e(car(setq ent(entsel"\n选择要拉伸的矩形边")))
        pt(cadr ent)
        vla_e(vlax-ename->vla-object e)
        p1(vlax-curve-getclosestpointto e pt)
        )
  ;;;;;;;对多段线或直线有效;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (cond((= (vla-get-objectname vla_e) "AcDbPolyline")
        (setq plst (lst->3p
               (vlax-safearray->list(vlax-variant-value(vla-get-coordinates vla_e)))
               2
               )
              )
        )
       ((= (vla-get-objectname vla_e) "AcDb2dPolyline")
        (setq plst (lst->3p
               (vlax-safearray->list(vlax-variant-value(vla-get-coordinates vla_e)))
               3
               )
              )
        )
       ((= (vla-get-objectname vla_e) "AcDbLine")
        (setq plst (list(vlax-curve-getstartpoint e)
                        (vlax-curve-getendpoint e)
                   )
        )
       )
      )
  ;;;;;;;;;;根据角度相等找到选边时点击点的边的2个点，此方法并不严谨，可能会出错;;;;;;;;;;;;;;;;;;;
  (mapcar '(lambda(x) (setq anglst (cons(list(if (>= (angle p1 x)pi)(angle x p1)(angle p1 x)) x) anglst)))plst)
  (setq anglst (vl-sort anglst '(lambda(x y) (< (car x)(car y) ))))
  (while anglst
  (setq assocang (caar anglst) assocp (cadar anglst))
  (if(member(fixnum(caar anglst))(mapcar '(lambda(x)(fixnum (car x))) (setq anglst (cdr anglst))))
     (setq stretchplst(list assocp (cadar anglst)))
    )
   )
  
  (setq stretchplst
         (vl-sort stretchplst(function(lambda(x y)
           (if (equal (car x) (car y))(< (cadr x) (cadr y))(< (car x) (car y)))))))
  ;;;;;;;;;;;;;;;;;;;;;;;;stretch命令;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (vl-cmdf "_.stretch"
                (ssget "c" (list (- (car(car stretchplst)) 1e-3)(- (cadr(car stretchplst)) 1e-3))
                  (list (+(car(cadr stretchplst)) 1e-3)(+ (cadr(cadr stretchplst)) 1e-3)))
             "" p1 pause)
  (princ)
  )
;;;;;;函数：将点表num个一组重新组表，用于处理多段线顶点坐标;;;;;;;;;;;;;;;;;
(defun lst->3p (lst num / n lst_new1 lst_newpoint)
  (setq n 0)
  (mapcar
    (function
      (lambda (x)
        (setq lst_new1 (append lst_new1 (list x)))
        (if (= (rem (1+ n) num) 0)
          (progn
            (setq lst_newpoint (append (list lst_new1) lst_newpoint))
            (setq lst_new1 nil)
          )
        )
        (setq n (1+ n))
      )
    )
    lst
  )
lst_newpoint
)
(defun fixnum(bl)
      (setq bl (/(fix (* bl (expt 10.0 3)))(expt 10.0 3)))
  )

hzh2000

直接使用Autocad的拉伸命令不是更好用？

cj52000

这个程序支持动态输入，我个人感觉比CAD自带的命令快，好用，呵呵

qq229918602

说实话不明白是怎么样的。能用动态图用一下命令么？

690994

程序用的是stretch，达不到楼主的要求，
最好的是通过几何计算修改多义线或直线的参数点更新。