[求助]：如何把多条直线按指定的距离在线段两端缩短或者加长

118_lj · 发表于 2005-10-20 16:13:19

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

如何把一次选择的多条直线按指定的距离在线段两端缩短或者加长，望高手指点。。谢谢~~

WHGF · 发表于 2005-10-20 16:28:48

只能通过程序解决！手工太慢！

xyp1964 · 发表于 2005-10-20 17:19:29

[FONT=courier new](load "xyp_lib")
;|加载通用函数(可在签名栏直接下载)
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
★1·在acad.lsp中增加(load"xyp_lib")
■2·在每个程序内增加(load"xyp_lib")
■3·在command下，输入(load"xyp_lib")
■4·在菜单.mnl中增加(load"xyp_lib")
■5·将xyp_lib.vlx文件直接拽到cad屏幕
★通用函数下载地址：
[url]http://www.xdcad.net/forum/attachme...&postid=1606661[/url]
[url]http://www.mjtd.com/bbs/dispbbs.asp...ID=37554&page=1[/url]|;
;把多条直线按指定的距离在线段两端缩短或者加长
(defun c:test ()
(CMDLA0)
(setq no1 (UREAL 1 "" "\n两端各增减的距离" no1)
ss (ssget '((0 . "LINE")))
i -1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq pts (dxf 10 (entget s1))
pte (dxf 11 (entget s1))
ang (angle pts pte)
pts-new (polar pts ang (* no1 -1.0))
pte-new (polar pte ang (* no1 1.0))
)
(sub_upd s1 10 pts-new)
(sub_upd s1 11 pte-new)
)
(CMDLA1)
)[/FONT]

[FONT=courier new](load "xyp_lib") 
;|加载通用函数(可在签名栏直接下载) 
如果已经下载xyp_lib并放到搜索路径下可以不再下载! 
利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序： 
★1·在acad.lsp中增加(load"xyp_lib") 
■2·在每个程序内增加(load"xyp_lib") 
■3·在command下，输入(load"xyp_lib") 
■4·在菜单.mnl中增加(load"xyp_lib") 
■5·将xyp_lib.vlx文件直接拽到cad屏幕 
 ★通用函数下载地址： 
[url]http://www.xdcad.net/forum/attachme...&postid=1606661[/url] 
[url]http://www.mjtd.com/bbs/dispbbs.asp...ID=37554&page=1[/url]|; 
 
;把多条直线按指定的距离在线段两端缩短或者加长 
(defun c:test () 
  (CMDLA0) 
  (setq        no1 (UREAL 1 "" "\n两端各增减的距离" no1) 
        ss  (ssget '((0 . "LINE"))) 
        i   -1 
  ) 
  (while (setq s1 (ssname ss (setq i (1+ i)))) 
    (setq pts          (dxf 10 (entget s1)) 
          pte          (dxf 11 (entget s1)) 
          ang          (angle pts pte) 
          pts-new (polar pts ang (* no1 -1.0)) 
          pte-new (polar pte ang (* no1 1.0)) 
    ) 
    (sub_upd s1 10 pts-new) 
    (sub_upd s1 11 pte-new) 
  ) 
  (CMDLA1) 
)[/FONT]

ttthhh_hb · 发表于 2005-10-20 21:54:54

最初由 118_lj 发布
[B]如何把一次选择的多条直线按指定的距离在线段两端缩短或者加长，望高手指点。。谢谢~~ [/B]

[php]
(defun c:de( / ss i ent spt ept 1st 2st dz st)
 (setq ss (ssget '((0 . "*LINE,ARC"))))
 (IF (NOT S)
(SETQ S 2)
 )
 (SETQ dz S)
 (SETQ ST (RTOS dz 2 4))
 (INITGET 2)
 (PRINC "\n请输入增量值：<")
 (PRINC ST)
 (PRINC ">:")
 (SETQ dz (GETREAL))
 (IF (NOT dz)
(SETQ dz S)
 )
 (SETQ S dz)
 (setq i 0)
 (repeat (sslength ss)
(setq ent (ssname ss i))
(setq spt (vlax-curve-getstartpoint ent))
(setq ept (vlax-curve-getendpoint ent))
(setq 1st (list ent spt))
(setq 2st (list ent ept))
(command "LENGTHEN" "DE" dz 1st 2st "")
(setq i (1+ i))
 )
 (princ)
)[/php]

118_lj · 发表于 2005-10-21 09:14:30

多谢各位！！！！！

狂刀 · 发表于 2005-10-21 11:45:43

!!! 支持所有曲线:

;; dlen = 双向伸缩曲线长度v1.1---狂刀2005.3.25 ok!.
(defun c:dlen (/ d i ss e lst1 lst2)
(vl-cmdf ".undo" "be")
(initget 128)
(if (and (setq d (getdist "\n 输入双向伸缩长度(负数为缩短):")
i -1
)
(setq ss (ssget '((0 . "LINE,ARC,ELLIPSE,*POLYLINE,SPLINE"))))
)
(while (setq e (ssname ss (setq i (1+ i))))
(setq lst1 (list e (vlax-curve-getstartpoint e))
lst2 (list e (vlax-curve-getendpoint e))
)
(vl-cmdf ".LENGTHEN" "de" d lst1 lst2 "")
)
)
(vl-cmdf ".undo" "e")
(princ)
)

sujia · 发表于 2005-10-21 11:50:17

如果需要只在一端(注意不是双向啊)缩短或者加长怎么办呢?

前提是批量的线, 伸长端为靠近选择端,选择方式自动为"F"画线选择
望高手指点。。谢谢~~

qjcpj · 发表于 2005-10-22 10:16:00

其实用好LENGTHEN命令就足够了。

xyp1964 · 发表于 2005-10-22 16:16:46

最初由狂刀发布
[B]!!! 支持所有曲线:
[code]
;; dlen = 双向伸缩曲线长度v1.1---狂刀2005.3.25 ok!.
(defun c:dlen (/ d i ss e lst1 lst2)
  (vl-cmdf ".undo" "be")
  (initget 128)
  (if (and (setq d (getdist "\n 输入双?.. [/B]

SPLINE线→“无法拉长此对象。”

楼上程序修改（未考虑伸长时的“长度无效”情况）。
双向伸缩曲线长度，不能伸缩的则亮显。
[php]
;;;双向伸缩曲线长度，不能伸缩的则亮显。
(defun c:test245 ()
  (cmdla0)
  (setq no1 (UREAL 1 "" "\n输入双向伸缩长度(负数为缩短) : " no1)
ss  (ssget '((0 . "LINE,ARC,ELLIPSE,*POLYLINE,SPLINE")))
i -1
  )
  (while (setq s1 (ssname ss (setq i (1+ i))))
(if (or (> no1 0)
      (> (vlax-curve-getDistAtParam
   s1
   (vlax-curve-getEndParam s1)
         )
         (* no1 -2.0)
      )
)
   (progn
;29246.0;14829.1093
(setq sel1  (list s1 (vlax-curve-getstartpoint s1))
      sel2  (list s1 (vlax-curve-getendpoint s1))
      leng1 (vlax-curve-getDistAtParam
      s1
      (vlax-curve-getEndParam s1)
      )
)
(command "LENGTHEN" "de" no1 sel1 sel2 "")
(setq leng2 (vlax-curve-getDistAtParam
      s1
      (vlax-curve-getEndParam s1)
      )
)
(if (= leng1 leng2)
   (redraw s1 3)
)
   )
   (redraw s1 3)
)
  )
  (cmdla1)
)
[/php]

狂刀 · 发表于 2005-10-22 17:46:20

SPLINE线由于自身原因不能伸长(其实也不是不能啦,只是不能按数学模型伸长,但是可以沿着端点切线伸长),但是却可以缩短.
(if (or (> no1 0)
      (> (vlax-curve-getDistAtParam
      s1
      (vlax-curve-getEndParam s1)
         )
         (* no1 -2.0)
      )
)

作判断我觉得可以两说.不能延伸或缩短的,cad给出提示也没有什么不好.
如果没有提示,以为已经缩短或伸长了,其实没有,尤其在对选集操作的时候,不容易发现.反而不好

顺便发一个函数
.

[FONT=courier new]
;| extspl = spline 双向伸长ok!--by 狂刀.2005.10
返回: 修改后的实体,实体名ename.
说明: 本函数仅仅对非拟合的spline有效!,即:没有offset的spline.
实例:
c:extspl
[/FONT]

复制代码

狂刀 · 发表于 2005-10-22 20:45:53

演示:

陈小云 · 发表于 2005-11-17 18:14:15

两位编程高手都很厉害。
佩服狂刀和xyp。
收不收徒弟呢。

Groovy · 发表于 2006-9-25 15:36:20

能不能在原来的端点处设置断点啊
两端伸长以后变为3条线段，
增加这样一个选项

听鱼 · 发表于 2006-9-25 20:12:28

今天刚好碰到这个问题,正是时候哟,我想把太短的等高线(已拟合的多段线)拉长可以吧?

账号		自动登录	找回密码
密码			立即注册

[求助] [求助]：如何把多条直线按指定的距离在线段两端缩短或者加长

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

Re: [求助]：如何把多条直线按指定的距离在线段两端缩短或者加长