[分享]：实体动态延伸模块

qjcpj

;;Program Name:dtys.vlx(AutoCAD R2000及以上版本适用)
;;Description:动态延伸，现支持LINE,POLYLINE,LWPOLYLINE,CIRCLE,ARC,ELLIPSE"。
;;Useage：AutoCAD R14 ~ R2006。
;;使用:模块加载后，命令行输入dtys
;;Copyright(C), QJCPJ, ALL RIGHTS RESERVED。
;;Email: qjzchpjia@126.com   qjzchpjia@sina.com
;;其它：本模块动态滑移部分年初在论坛上得到了LUCAS斑竹的无私指导，值此表示感谢。

因大部分网友都使用AutoCAD R2000及以上版本，故现打包dtys.vlx附件上传；如果有需要在AutoCAD R14版本下模块，我会近期再打包成dtys.arx附件上传！
附件dtys.vlx如下：

eachy

不错，和Length命令的动态比基点更直观

xyp1964

建议在程序的最后增加：
(princ"程序命令：dtys  (动态延伸)")
类似的提示信息。

qjcpj

谢谢xyp1964斑竹的建议。
该模块是本人在工作中因lengthen命令不太方便而重编写的，拓展了该命令的一些功能，我最常用的就是利用它动态延伸有宽度信息的多义线。

eachy

在 2006 下拖曳夹点就可以了

qjcpj

拖曳夹点,在0度和90度情况下还可以，但任意角度多义线拖曳夹点时无法精确控制角度。

eachy

最初由 qjcpj 发布
[B]拖曳夹点,在0度和90度情况下还可以，但任意角度多义线拖曳夹点时无法精确控制角度。 [/B]

打开追踪功能

liangcheng_xia

能让大家看看源代码吗？

qjcpj

暂不想公布源码，模块在处理旧多义线(R13及以下版本生成的POLYLINE实体)时还存在一小bug。

dandee

試用了﹐ 看得出由于用了grread﹐沒有捕捉方式 ﹐ 也沒有方向性數值輸入。
無法精確調整長度 。
作者可以繼續 加強其功能。

此程序﹐ 是下面程序的功能擴展﹐ 希望有更多的這樣的程序出現 。   
。
(defun C:TTc(/ enline old_cmdEcho old_osmode en PT ret Next_PT typ)
  (vl-load-com)
  (setq        old_cmdEcho (getvar "CMDECHO")
        old_osmode  (getvar "OSMODE"))
  (setq en (car (entsel "\nSELECT LINE: ")))
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setq PT (cadr (grread 1 1)))
  (while PT
    (setq ret (grread 1 1))
    (setq Next_PT (cadr ret)
          typ          (car ret))
    (cond ((= typ 5)
           (if (not (equal Next_PT PT 0.00000001))
             (progn
               (redraw)
               (updline Next_PT en enline)
               ))
           (setq PT Next_PT))
          ((= typ 3)
        (if (not (equal Next_PT PT 0.00000001))

         (updline Next_PT en enline)

         )

           (setq PT nil))
          (T (setq PT Next_PT))))
(entdel enline)
  (redraw)
  (setvar "CMDECHO" old_cmdEcho)
  (setvar "OSMODE" old_osmode)
  (princ)
  )
;;-------------------------------------------------
(defun updline        (pt enc enl / pt1 el)
  (setq pt1 (vlax-curve-getClosestPointTo enc pt))
  (DrawMark pt1)
  (if (not (boundp 'enl))
    (if        (vl-cmdf "_.line" pt pt1 "")
      (setq enline (entlast)))
    (if        (not (equal pt1 pt 0.00000001))
      (progn
        (setq el (entget enl))
        (setq el (subst (cons 10 pt) (assoc 10 el) el))
        (setq el (subst (cons 11 pt1) (assoc 11 el) el))
        (entmod el)
        )
      )
    )
  )

(defun DrawMark(p / marksize)
  (setq marksize (/ (getvar "viewsize") 25))
  (grdraw (polar p pi (* marksize 0.5))(polar p 0 (* marksize 0.5)) 141)
  (grdraw (polar p (* pi 0.5) (* marksize 0.5))(polar p (* pi 1.5) (* marksize 0.5)) 141))

qjcpj

谢谢11楼楼主的建议。如果仅需动态延伸LINE或ARC，下面代码即可实现：
(defun C:TTc()
        (princ "\n选择要修改的直线或圆弧：\n")
        (command "_lengthen" "dy")
)

dtys模块程序开发点重在“动态”和对椭圆和多义线的支持，精確調整長度功能可在AutoCAD的内置命令Lengthen中实现。

ysx810210

强烈增加捕捉功能,