线段 两端同时缩短指定长度，怎么实现

hyhhj

下面这段程序只能实现一端宿指定长度，我想要两端同时缩短指定指定长度，那位大神，帮我修改下

(defun c:dj ()
  (setvar "cmdecho" 0)
  (if (null old-len)
    (setq old-len 0)
  )
  (if (setq len
             (getreal
               (strcat "\n输入一个增量值(负值为减量)<" (rtos old-len) ">:")
             )
      )
    (setq old-len len)
    (setq len old-len)
  )

  (command "LENGTHEN" "de" len)
  (while (/= 0 (getvar "cmdactive"))
    (prompt "\n选择要修改的对象或 [放弃(U)]:")
    (command pause)
  )
  (setvar "cmdecho" 1)
  (princ)
)

start4444

edsion24 发表于 2021-3-20 23:41
大神能否让这个程序支持多段线呢？

start4444

;;直线两端伸缩
(defun c:tt5 (/ entname len p10 p11)
  (setvar "cmdecho" 0)
  (if (null old-len)
    (setq old-len 0)
  )
  (if (setq len
                                (getreal
                                        (strcat "\n输入一个增量值(负值为减量)<" (rtos old-len) ">:")
                                )
      )
    (setq old-len len)
    (setq len old-len)
  )
        (while  (setq entname (car (entsel "\n请选择对象:")))
                (setq p10 (cdr (assoc 10 (entget entname))) p11 (cdr (assoc 11 (entget entname))))
                (command "LENGTHEN" "de" len (list entname p10) (list entname p11) "")
  )
  (setvar "cmdecho" 1)
  (princ)
)

start4444

tigcat 发表于 2021-3-18 16:21
这个金牌会员靠回帖搞来的

找几个例子认真看一下就懂了，下次别再问那些什么批量、记忆上次什么的了

;;直线两端伸缩 (批量)
(defun c:tt5 (/ entname i len p10 p11 ss key)
  (setvar "cmdecho" 0)
  (if (null old-len)
    (setq old-len 0)
  )
  (if (setq len
                                (getreal
                                        (strcat "\n输入一个增量值(负值为减量)<" (rtos old-len) ">:")
                                )
      )
    (setq old-len len)
    (setq len old-len)
  )
       
        (setq ss (ssget '((0 . "LINE"))))
        (setq i -1)
        (while (setq entname (ssname ss (setq i (1+ i))))
                (setq p10 (cdr (assoc 10 (entget entname))) p11 (cdr (assoc 11 (entget entname))))
                (command "LENGTHEN" "de" len (list entname p10) (list entname p11) "")               
        )
        (while  (/= key "e")
               
                (setq key (getstring "\n是否继续操作？[增长(Q)/缩短(W)/退出(E)]<上一次>："))
               
                (cond
                        ((= key "") (setq i -1) (while (setq entname (ssname ss (setq i (1+ i)))) (setq p10 (cdr (assoc 10 (entget entname))) p11 (cdr (assoc 11 (entget entname)))) (command "LENGTHEN" "de" len (list entname p10) (list entname p11) "")))
                        ((= key "q") (if (< len 0) (setq len (* len -1))) (setq i -1) (while (setq entname (ssname ss (setq i (1+ i)))) (setq p10 (cdr (assoc 10 (entget entname))) p11 (cdr (assoc 11 (entget entname)))) (command "LENGTHEN" "de" len (list entname p10) (list entname p11) "")))
                        ((= key "w") (if (< len 0) () (setq len (* len -1))) (setq i -1) (while (setq entname (ssname ss (setq i (1+ i)))) (setq p10 (cdr (assoc 10 (entget entname))) p11 (cdr (assoc 11 (entget entname)))) (command "LENGTHEN" "de" len (list entname p10) (list entname p11) "")))
                )
               
  )
        (prompt "\n***已退出命令!***")
  (setvar "cmdecho" 1)
  (princ)
)

hyhhj

start4444 发表于 2021-3-18 12:27
;;直线两端伸缩
(defun c:tt5 (/ entname len p10 p11)
  (setvar "cmdecho" 0)

谢谢，我测试了真的可以唉，太感谢了

tigcat

start4444 发表于 2021-3-18 12:27
;;直线两端伸缩
(defun c:tt5 (/ entname len p10 p11)
  (setvar "cmdecho" 0)

大侠，能批量直线吗？

start4444

tigcat 发表于 2021-3-18 15:49
大侠，能批量直线吗？

你都金牌会员了，别总问这些基本操作的问题啊

tigcat

start4444 发表于 2021-3-18 16:17
你都金牌会员了，别总问这些基本操作的问题啊

这个金牌会员靠回帖搞来的

bonny

点赞，十个手指不够

tigcat

start4444 发表于 2021-3-18 17:11
找几个例子认真看一下就懂了，下次别再问那些什么批量、记忆上次什么的了

;;直线两端伸缩 (批量)

好的，会努力学习的。看来大侠看到批量这几个字比较敏感

趣意人生

收藏学习了！