可以批量双向延长或者缩短的lsp程序求分享

fkyourmather

可以批量双向延长或者缩短的lsp程序求分享

XDSoft

截取个图片说明上来吧，让大家清楚问题和你的需要。

fkyourmather

晓东 你有直线批量双向延长的代码吗
和分层统计长度的代码吗

fkyourmather

XDSoft 发表于 2013-4-11 12:19

                               
登录/注册后可看大图

截取个图片说明上来吧，让大家清楚问题和你的需要。

直线俩段  批量双向延长的代码吗
和
在不同的分层里面 统计长度的代码吗

XDSoft

fkyourmather 发表于 2013-4-11 12:26

                               
登录/注册后可看大图

直线俩段  批量双向延长的代码吗
和
在不同的分层里面 统计长度的代码吗

统计长度的，昨天的帖子好像就有，找找。

你还是截取个图吧，两边延长延长多少，延长到哪。

提问题时候与人方便就是与自己方便。

炫翔

你要延长的是什么线？直线，多段线，样条？

fkyourmather

XDSoft 发表于 2013-4-11 12:46

                               
登录/注册后可看大图

统计长度的，昨天的帖子好像就有，找找。

你还是截取个图吧，两边延长延长多少，延长到哪。

双向延长其实这个不好用图片的，用了图片容易挂掉，比如我有一条直线2000mm俩个AB端点，可以俩个方向延长指定的距离或者缩短俩个指定的距离~

fkyourmather

炫翔 发表于 2013-4-11 13:40

                               
登录/注册后可看大图

你要延长的是什么线？直线，多段线，样条？

当然是都可以的啦!

fkyourmather

fkyourmather 发表于 2013-4-12 15:48

                               
登录/注册后可看大图

当然是都可以的啦!

那就直线可以的

仲文玉

直线

zxq0220

[pcode=lisp,true]
(defun c:tt ()
  (setvar "CMDECHO" 0)
  (if (and
        (princ "\n选择直线:")
        (setq ss (ssget '((0 . "LINE"))))
        (setq dd (getreal "\n长度变化量: "))
      )
    (progn
      (setq i -1)
      (repeat (sslength ss)
        (setq en (ssname ss (setq i (1+ i)))
              ent (entget en)
              p1 (cdr (assoc 10 ent))
              p2 (cdr (assoc 11 ent))
              ds (distance p1 p2)
        )
        (if (> (+ ds dd) 0)
          (progn
            (setq p1 (polar p1 (angle p2 p1) (/ dd 2))
                  p2 (polar p2 (angle p1 p2) (/ dd 2))
                  ent (subst
                        (cons 10 p1)
                        (assoc 10 ent)
                        ent
                      )
            )
            (entmod (subst
                      (cons 11 p2)
                      (assoc 11 ent)
                      ent
                    )
            )
          )
        )
      )
    )
  )
  (princ)
)

[/pcode]

zhuizhu

{:soso_e179:}学习了，谢谢分享！

yoyoho

感謝 zxq0220  分享程序!:)

Free-Lancer

初学者
[pcode=lisp,true](defun c:tt (/ ss sl i e sp ep d)
  (while (and (setq d (getdist "\n增量距离: ")) ;_可输入，可拾取（仅为正值),收缩时输入负值
              (setq ss (ssget '((0 . "line"))))
         )
    (setq sl (sslength ss)
          i  -1
    )
    (repeat sl
      (setq e  (ssname ss (setq i (1+ i)))
            sp (vlax-curve-getstartpoint e)
            ep (vlax-curve-getendpoint e)
      )
      (vl-cmdf ".lengthen" "_de" d (list e sp) (list e ep) "")
    )
  )
  (princ)
)[/pcode]

fkyourmather

仲文玉 发表于 2013-4-13 10:50

                               
登录/注册后可看大图

直线

谢谢分享，非常好的