设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 怎样实现多义线的随意拉伸
123下一页
返回列表 发新帖
查看: 10242|回复: 22

[已解答] 怎样实现多义线的随意拉伸

  [复制链接]
menger_8
发表于 2011-11-7 19:55:08 来自手机 | 显示全部楼层 |阅读模式
本帖最后由 menger_8 于 2011-11-7 20:48 编辑

[之前下的一个可以随意拉伸的vlx，点选多边形的任意边然后移动鼠标就可以实现与stretch相同的效果，想了很久，矩形很容易实现，但不规则形状的多边形不知道如何判断选中的是哪个边并实现拉伸，找了很久好像没有这方面的函数，望各位大虾能提供思路，附上网上下载的别人的插件
attach]62228[/attach]

本帖子中包含更多资源

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

x
回复

使用道具 举报

yjr111
发表于 2011-11-7 20:02:41 | 显示全部楼层
这个功能好，期待ing
回复 支持 反对

使用道具 举报

cushi
发表于 2011-11-7 21:42:31 | 显示全部楼层
在autocad的教学里就有，每个人都可以自学。
回复 支持 反对

使用道具 举报

校长
发表于 2011-11-7 21:52:06 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
回复 支持 反对

使用道具 举报

669423907
发表于 2011-11-7 23:16:38 | 显示全部楼层
多谢楼主分享
回复 支持 反对

使用道具 举报

menger_8
 楼主| 发表于 2011-11-9 12:25:13 | 显示全部楼层
这个问题没有高手能解决么，期待中……
回复 支持 反对

使用道具 举报

xiaxiang
发表于 2011-11-9 14:26:09 | 显示全部楼层
本帖最后由 xiaxiang 于 2011-11-9 14:26 编辑

  3. (defun c:tt(/ pta3 ptb3 pt2n pt2nb i0)
  4. (setq oldos (getvar "osmode")) ;保存捕捉特性给oldos  
  5.   (setvar "cmdecho" 0)
  6.   (setvar "osmode" 247)
  7.   (command "undo" "be")
  8.   (if(= dis nil)
  9.     (while(not(setq dis (getreal "\n请输入拉伸距离:"))))
  10.     (setq dis (getreal (strcat "\n请输入拉伸距离:<" (rtos dis 2) ">")))
  11.   )
  12.   (if(= dis nil)(setq dis disold)(setq disold dis))
  13.   
  14.   (while(setq s1 (entsel "\n请指定拉伸的边:"))
  15.     (setq pta3 nil ptb3 nil pt2n nil pt2nb nil i0 nil)
  16.   (setq enlst (entget(car s1)))
  17.   (setq pt_lst'())
  18.   (if(= (cdr(assoc 0 enlst)) "LWPOLYLINE")
  19.     (progn
  20.       (setq p1 (cadr s1))
  21.       (command "circle" p1 1)
  22.       (setq p1 (cdr(assoc 10 (entget(entlast)))))
  23.       (entdel (entlast))
  24.       (setvar "osmode" 0)
  25.       (terpri)(while(not(setq ps1 (getpoint "\n请指定拉伸方向:"))))
  26.       (setvar "osmode" 247)
  27.       (foreach i enlst (if(or(= (car i) 10)(= (car i) 42))(setq pt_lst (cons (cdr i) pt_lst))))
  28.       (setq pt_lst (reverse pt_lst))
  29.       (setq i 0)
  30.       (while (setq p0 (nth i pt_lst))
  31. (setq p2 (nth (+ i 2) pt_lst))
  32. (if(= p2 nil)(setq p2 (nth 0 pt_lst) i0 -2)(setq i0 i))
  33. (setq ang1a (angle p0 p1))
  34. (setq ang2a (angle p1 p2))
  35. (if(or(equal ang1a ang2a 0.001)(equal (+ pi pi ang1a) ang2a 0.001)(equal (+ pi pi ang2a) ang1a 0.001))
  36.    (progn
  37.      (setq pta1 p0 ptb1 p2)     
  38.      (command "area" "o" (car s1))
  39.      (setq are1 (getvar "Perimeter"))
  40.      (command "offset" "t" s1 ps1 "")
  41.      (setq ssx1 (entlast))
  42.      (command "area" "o" ssx1)
  43.             (setq are2 (getvar "Perimeter"))
  44.      (entdel ssx1)
  45.      (if(> are2 are1)(setq ffxx "1")(setq ffxx "0"))
  46.      (if(<(- i 1)0)(setq tdza (nth (+(- i 1)(length pt_lst))pt_lst))
  47.        (setq tdza (nth (- i 1) pt_lst)))
  48.       (if(<(- i 2)0)(setq pta2 (nth (+(- i 2)(length pt_lst))pt_lst))
  49.        (setq pta2 (nth (- i 2) pt_lst)))
  50.      (if(or(/= tdza 0)(and(= tdza 0)(<= (distance pta2 pta1) (* 2 (sqrt 2)))))
  51.        (progn
  52.   (if(<(- i 3)0)(setq tdza1 (nth (+(- i 3)(length pt_lst))pt_lst))
  53.     (setq tdza1 (nth (- i 3) pt_lst)))
  54.   (if(= tdza1 0)
  55.     (progn
  56.       (if(<(- i 4)0)(setq pta3 (nth (+(- i 4)(length pt_lst))pt_lst))
  57.         (setq pta3 (nth (- i 4) pt_lst)))
  58.       (setq angla (angle pta3 pta2))
  59.     )
  60.   )
  61.        )
  62.        (setq angla (angle pta2 pta1))
  63.      )
  64.      
  65.      (if(<(+ i0 3)(length pt_lst))
  66.        (setq tdzb (nth (+ i0 3) pt_lst))
  67.        (setq tdzb (nth (-(+ i0 3)(length pt_lst)) pt_lst))
  68.      )
  69.      (if(<(+ i0 4)(length pt_lst))
  70.        (setq ptb2 (nth (+ i0 4) pt_lst))
  71.        (setq ptb2 (nth (-(+ i0 4)(length pt_lst)) pt_lst))
  72.      )
  73.      (if(or(/= tdzb 0)(and(= tdzb 0)(<= (distance ptb2 ptb1) (* 2 (sqrt 2)))))
  74.        (progn
  75.   (if(<(+ i0 5)(length pt_lst))
  76.     (setq tdzb1 (nth (+ i0 5) pt_lst))
  77.     (setq tdzb1 (nth (-(+ i0 5)(length pt_lst)) pt_lst))
  78.   )
  79.   (if(= tdzb1 0)
  80.     (progn     
  81.       (if(<(+ i0 6)(length pt_lst))
  82.         (setq ptb3 (nth (+ i0 6) pt_lst))
  83.         (setq ptb3 (nth (-(+ i0 6)(length pt_lst)) pt_lst))
  84.       )
  85.       (setq anglb (angle ptb3 ptb2))
  86.     )
  87.   )
  88.        )
  89.        (setq anglb (angle ptb2 ptb1))
  90.      )
  91.      (setq anga1 (angle pta1 ptb1))
  92.      (setq angb1 (angle ptb1 pta1))
  93.      (if(equal anga1 (* 2 pi) 0.0001)(setq anga1 0))
  94.      (if(equal angb1 (* 2 pi) 0.0001)(setq angb1 0))
  95.      (setq anga2 (+ pi angla) angb2 (+ pi anglb))
  96.      (if(>= anga2(* 2 pi))(setq anga2(- anga2 pi pi)))
  97.      (if(>= angb2(* 2 pi))(setq angb2(- angb2 pi pi)))
  98.      
  99.      (if(> anga2 anga1)(setq anga3(- anga2 anga1))(setq anga3(- anga1 anga2)))
  100.      (if(> angb2 angb1)(setq angb3(- angb2 angb1))(setq angb3(- angb1 angb2)))
  101.      (setq disna (/ dis (abs(sin anga3))))
  102.      (setq disnb (/ dis (abs(sin angb3))))
  103.      (if(= ffxx "1")(setq pt1n (polar pta1 angla disna))(setq pt1n (polar pta1 (+ pi angla) disna)))
  104.      (if(= ffxx "1")(setq pt1nb(polar ptb1 anglb disnb))(setq pt1nb(polar ptb1 (+ pi anglb) disnb)))
  105.      (if(/= pta3 nil)(if(= ffxx "1")(setq pt2n (polar pta2 angla disna))(setq pt2n (polar pta2 (+ pi angla) disna))))
  106.      (if(/= ptb3 nil)(if(= ffxx "1")(setq pt2nb(polar ptb2 anglb disnb))(setq pt2nb(polar ptb2 (+ pi anglb) disnb))))
  107.      (setq i (length pt_lst))
  108.           )
  109. )
  110. (setq i (+ 2 i))
  111.       )
  112.       (setq e (car s1))
  113.       (setq m (entget e))
  114.       (setq m (subst (cons 10 pt1n)(cons 10 pta1)m))
  115.       (entmod m)
  116.       (setq m (subst (cons 10 pt1nb)(cons 10 ptb1)m))
  117.       (entmod m)
  118.       (entupd e)
  119.       (if(/= pt2n nil)
  120. (progn
  121.    (setq m (subst (cons 10 pt2n)(cons 10 pta2)m))
  122.    (entmod m)
  123.           (entupd e)
  124. )
  125.       )
  126.       (if(/= pt2nb nil)
  127. (progn
  128.    (setq m (subst (cons 10 pt2nb)(cons 10 ptb2)m))
  129.    (entmod m)
  130.           (entupd e)
  131. )
  132.       )
  133.     )
  134.     (prompt "\n<您选择的线不是多义线,请串接成多义线再运行此程序!!!>")
  135.   )
  136.   )
  137.   (command "undo" "e")
  138. (setvar "osmode" oldos)        ;还原捕捉
  139. )

回复 支持 反对

使用道具 举报

xshrimp
发表于 2011-11-9 15:22:17 | 显示全部楼层
本帖最后由 xshrimp 于 2011-11-9 15:52 编辑

参考



  4. (defun c:ofss (/ E G O P1 P2 V1 V2 V3)
  5.               ;|
  6. *************************************************************************************************
  7. *
  8. *        by ElpanovEvgeniy 26.02.2010
  9. *
  10. *        ----------------
  11. *        27.02.2010 8:30
  12. *        fix bug for acad 2004 (vlax-curve-getFirstDeriv e (vlax-curve-getEndParam e))
  13. *        ----------------
  14. *        27.02.2010 8:55
  15. *        fix bug for first arc segment
  16. *************************************************************************************************

  18. |;
  19. (setq e  (entsel)
  20.        p1 (cadr e)
  21.        e  (car e)
  22.        p1 (fix (vlax-curve-getParamAtPoint e (vlax-curve-getClosestPointTo e p1)))
  23.        o  (vlax-ename->vla-object e)
  24. ) ;_  setq
  25. (if (= 1 (cdr (assoc 70 (entget e))))
  26.   (cond ((zerop p1)
  27.          (setq p2 (1+ p1)
  28.                v1 (list (vlax-curve-getPointAtParam e (vlax-curve-getEndParam e))
  29.                         (vlax-curve-getFirstDeriv e (1- (vlax-curve-getEndParam e)))
  30.                   ) ;_  list
  31.                v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e 0.5))
  32.                v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e 1.5))
  33.          ) ;_  setq
  34.         )
  35.         ((= p1 (1- (vlax-curve-getEndParam e)))
  36.          (setq p2 0
  37.                v1 (list (vlax-curve-getPointAtParam e (1- p1))
  38.                         (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
  39.                   ) ;_  list
  40.                v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e (+ p1 0.5)))
  41.                v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e (+ p2 0.5)))
  42.          ) ;_  setq
  43.         )
  44.         ((setq p2 (1+ p1)
  45.                v1 (list (vlax-curve-getPointAtParam e (1- p1))
  46.                         (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
  47.                   ) ;_  list
  48.                v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e (+ p1 0.5)))
  49.                v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e (+ p2 0.5)))
  50.          ) ;_  setq
  51.         )
  52.   ) ;_  cond
  53.   (cond ((zerop p1)
  54.          (setq p2 (1+ p1)
  55.                v2 (list (vlax-curve-getPointAtParam e 0) (vlax-curve-getFirstDeriv e 0.5))
  56.                v1 (list (car v2) (list (cadadr v2) (- (caadr v2)) 0.))
  57.                v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e 1.5))
  58.          ) ;_  setq
  59.         )
  60.         ((= p1 (1- (vlax-curve-getEndParam e)))
  61.          (setq p2 (vlax-curve-getEndParam e)
  62.                v1 (list (vlax-curve-getPointAtParam e (1- p1))
  63.                         (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
  64.                   ) ;_  list
  65.                v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e (+ p1 0.5)))
  66.                v3 (list (vlax-curve-getPointAtParam e p2) (list (cadadr v2) (- (caadr v2)) 0.))
  67.          ) ;_  setq
  68.         )
  69.         ((setq p2 (1+ p1)
  70.                v1 (list (vlax-curve-getPointAtParam e (1- p1))
  71.                         (vlax-curve-getFirstDeriv e (+ (1- p1) 0.5))
  72.                   ) ;_  list
  73.                v3 (list (vlax-curve-getPointAtParam e p2) (vlax-curve-getFirstDeriv e (+ p2 0.5)))
  74.                v2 (list (vlax-curve-getPointAtParam e p1) (vlax-curve-getFirstDeriv e (+ p1 0.5)))
  75.          ) ;_  setq
  76.         )
  77.   ) ;_  cond
  78. ) ;_  if
  79. (while (= (car (setq g (grread nil 5 0))) 5)
  80.   (vla-put-coordinate
  81.    o
  82.    p1
  83.    (vlax-make-variant
  84.     (vlax-safearray-fill (vlax-make-safearray 5 '(0 . 1))
  85.                          (reverse (cdr (reverse (inters (car v1)
  86.                                                         (mapcar '+ (car v1) (cadr v1))
  87.                                                         (cadr g)
  88.                                                         (mapcar '+ (cadr g) (cadr v2))
  89.                                                         nil
  90.                                                 ) ;_  inters
  91.                                        ) ;_  reverse
  92.                                   ) ;_  cdr
  93.                          ) ;_  reverse
  94.     ) ;_  vlax-safearray-fill
  95.    ) ;_  vlax-make-variant
  96.   ) ;_  vla-put-coordinate
  97.   (vla-put-coordinate
  98.    o
  99.    p2
  100.    (vlax-make-variant
  101.     (vlax-safearray-fill (vlax-make-safearray 5 '(0 . 1))
  102.                          (reverse (cdr (reverse (inters (car v3)
  103.                                                         (mapcar '+ (car v3) (cadr v3))
  104.                                                         (cadr g)
  105.                                                         (mapcar '+ (cadr g) (cadr v2))
  106.                                                         nil
  107.                                                 ) ;_  inters
  108.                                        ) ;_  reverse
  109.                                   ) ;_  cdr
  110.                          ) ;_  reverse
  111.     ) ;_  vlax-safearray-fill
  112.    ) ;_  vlax-make-variant
  113.   ) ;_  vla-put-coordinate
  114. ) ;_  while
  115. (princ)
  116. )

本帖子中包含更多资源

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

x

点评

hgf876
不错！  发表于 2012-2-22 14:54
回复 支持 反对

使用道具 举报

soly2006
发表于 2011-11-9 15:26:53 | 显示全部楼层
经测试，有时候为何不能延伸？要点两下才又执行
回复 支持 反对

使用道具 举报

xiaxiang
发表于 2011-11-9 15:36:58 | 显示全部楼层
如果能用grread写出每次拉伸的步长，就更棒了！
回复 支持 反对

使用道具 举报

123下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2025-5-23 11:35 , Processed in 0.192547 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表