[分享]：波浪线绘制的LSP源程序!

刻录机 · 发表于 2003-11-5 08:41:56

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

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

×

绘制波浪线的LSP源程序!供大家分享顺便评评看实用不?
不过我一直在用.

(defun c:blx(/ lay os orth pt1 pt2 pt3 pt sel ang ang0 dist lis)
(setq lay (getvar "clayer"))
(setq os (getvar "osmode"))
(setq orth (getvar "orthomode"))
(setq temperr *error*)
(setq *error* trap)
(command "undo" "be")
(princ "\n绘波浪线程序")
(princ "\n1.两点方式 2.多点方式")
(setq sel (getint "\n请选择:<1>"))
(if (or (null sel) (= sel 1))
(progn
(setvar "osmode" 512)
(setvar "orthomode" 0)
(while (not (setq pt1 (getpoint "\n请拾取第一点:"))))
(while (not (setq pt2 (getpoint pt1 "\n请拾取第二点:"))))
(setq ang0 (angle pt1 pt2))
(setq dist (/ (/ (distance pt1 pt2) 20) (sin (/ pi 3))))
(setq lis (list (- 0 (/ pi 6)) (/ pi 6) (/ pi 6) (- 0 (/ pi 6))))
(setvar "osmode" 0)
(setvar "clayer" "0")
(command "pline" pt1)
(setq pt3 pt1)
(repeat 5
(foreach ang lis
(progn
(setq pt (polar pt3 (+ ang0 ang) dist))
(setq pt3 pt)
(command pt)
)
)
)
(command "")
(command "pedit" (entlast) "s" "x")
)
(progn
(setvar "osmode" 513)
(setvar "clayer" "thin")
(setvar "orthomode" 0)
(setq pt(getpoint "\n请逐一选取各点:"))
(command "pline" pt)
(setq pt3 pt)
(while (setq pt (getpoint pt3 "\n选取点(回车结束)"))
(progn
(setq pt3 pt)
(command pt))
)
(command "")
(command "pedit" (entlast) "s" "x")
)
)
(setvar "orthomode" orth)
(setvar "clayer" lay)
(setvar "osmode" os)
(command "undo" "e")
(princ)
)

(defun c:blx(/ lay os orth pt1 pt2 pt3 pt sel ang ang0 dist lis) 
(setq lay (getvar "clayer")) 
(setq os (getvar "osmode")) 
(setq orth (getvar "orthomode")) 
 
(setq temperr *error*) 
(setq *error* trap) 
(command "undo" "be") 
 
(princ "\n绘波浪线程序") 
(princ "\n1.两点方式    2.多点方式") 
(setq sel (getint "\n请选择:<1>")) 
(if (or (null sel) (= sel 1)) 
(progn 
(setvar "osmode" 512) 
(setvar "orthomode" 0) 
(while (not (setq pt1 (getpoint "\n请拾取第一点:")))) 
(while (not (setq pt2 (getpoint pt1 "\n请拾取第二点:")))) 
(setq ang0 (angle pt1 pt2)) 
(setq dist (/ (/ (distance pt1 pt2) 20) (sin (/ pi 3)))) 
(setq lis (list (- 0 (/ pi 6)) (/ pi 6) (/ pi 6) (- 0 (/ pi 6)))) 
(setvar "osmode" 0) 
(setvar "clayer" "0") 
(command "pline" pt1) 
(setq pt3 pt1) 
(repeat 5 
(foreach ang lis 
(progn 
(setq pt (polar pt3 (+ ang0 ang) dist)) 
(setq pt3 pt) 
(command pt) 
) 
) 
) 
(command "") 
(command "pedit" (entlast) "s" "x") 
) 
(progn 
(setvar "osmode" 513) 
(setvar "clayer" "thin") 
(setvar "orthomode" 0) 
(setq pt(getpoint "\n请逐一选取各点:")) 
(command "pline" pt) 
(setq pt3 pt) 
(while (setq pt (getpoint pt3 "\n选取点(回车结束)")) 
(progn 
(setq pt3 pt) 
(command pt)) 
) 
(command "") 
(command "pedit" (entlast) "s" "x") 
) 
) 
(setvar "orthomode" orth) 
(setvar "clayer" lay) 
(setvar "osmode" os) 
(command "undo" "e") 
(princ) 
)

zhynt · 发表于 2003-11-5 13:04:59

小问题：
(setvar "clayer" "thin")
其中由于不是每个图中都有“thin”这个图层，因此当图中没有这个图层是程序将出错退出。
所以在使用这个图层前用先搜索图层表，如果有这个图层，则直接设定这个图层为当前图层，如果没有则应先进行图层的添加操作。
另外：最好能对波峰、波谷及周期进行控制。

刻录机 · 发表于 2003-11-5 16:11:26

(setvar "clayer" "thin")
将其设为自有的层即可。如：(setvar "clayer" "0") 0层是都有的，不过要记得控制其打印粗细，一般波浪线是细线。

谢谢zhynt点评！！

(一点鼓励都没有，我苦！)

aeo · 发表于 2003-11-8 12:44:39

要点评,哈 :)

不管线多长,波浪数量总是一样的,好象不好,应该可以控制每个波浪有多少距离,再算出波浪的数量,这样好些.或者控制一个比例.

图层也不应该就设一下,还要判断有没有,没有就建一个.

--------------------
(princ "\n绘波浪线程序")
(princ "\n1.两点方式 2.多点方式")
(setq sel (getint "\n请选择:<1>"))
(if (or (null sel) (= sel 1))
-----------------------
这样写当然可以,但一般不这样写:用initget控制一下.

而且没必要分出来,应该是用户一直点下去,就不停的画下去比较好:
(setq p1(getpoint "\n第一点"))
(while (setq p2(getpoint"\n下一点"))
(画波浪线 p1 p2)
(setq p1 p2)
)
(defun 画波浪线(p1 p2)
... ...)

zhynt · 发表于 2003-11-12 08:12:42

我修改了一下：(加入波幅与波长的控制，以及采用“spline”绘制波浪线，并可连续绘制)
<img src="http://www.xdcad.net/modrator/file_upload/5453/20031112083735_blx.jpg" width="750" height="350">

注：由于波浪线的直线长度不一定能被波长整除，所以，我先用直线长除以波长取其整数（即波数）然后再用直线长除以波数，得到实际波长。也就是说实际画的波长要比你给的波长来的短。但是如果直线长恰好能被波长整除，那前后就一样了。
修改了一下，增加了是否重新计算波长的选项

(defun c:blx (/ boch pt pt1 pt2 pt3 dist lis ang0 ang)
(SETQ OLDOS (GETVAR "OSMODE"))
(if (= bofu nil)
(setq bofu1 20)
)
(if (= bochang nil)
(setq bochang1 50)
)
(if (/= (setq oldcmd (getvar "cmdecho")) 0)
(setvar "cmdecho" 0)
)
(prompt "\n请输入波幅<")
(princ bofu1)
(if (= (setq bofu (getreal ">:")) nil)
(setq bofu bofu1)
(setq bofu1 bofu)
)
(prompt "\n请输入波长<")
(princ bochang1)
(if (= (setq bochang (getreal ">:")) nil)
(setq bochang bochang1)
(setq bochang1 bochang)
)
(initget "Yes No")
(setq id (getkword "\n是否重新计算波长？Yes [No]:"))
(if (= id nil)
(setq id "No")
)
(if (setq pt1 (getpoint "\n开始画波浪线(回车退出):"))
(progn
(while (setq pt2 (getpoint pt1 "\n下一点(回车退出):"))
(setq dist (distance pt1 pt2))
(setq ang0 (angle pt1 pt2))
(setq n (fix (/ dist bochang)))
(while (= n 0)
(prompt "\n该段长度比波长小，请重新输入:")
(setq pt2 (getpoint pt1 "\n下一点(回车退出):"))
(if (/= pt2 nil)
(progn
(setq dist (distance pt1 pt2))
(setq ang0 (angle pt1 pt2))
(setq n (fix (/ dist bochang)))
)
(setq n nil)
)
)
(if (/= pt2 nil)
(progn
(if (= id "No")
(setq boch (/ bochang 4))
(setq boch (/ dist (* n 4)))
)
(setq dist (sqrt (+ (* boch boch) (* bofu bofu))))
(setq lis (list (atan bofu boch)
(- 0 (atan bofu boch))
(- 0 (atan bofu boch))
(atan bofu boch)
)
)
(setq pt3 pt1)
(IF (< (- OLDOS 16384) 0)
(SETVAR "OSMODE" (+ OLDOS 16384))
)
(command "spline" pt1)
(repeat n
(foreach ang lis
(setq pt (polar pt3 (+ ang0 ang) dist))
(setq pt3 pt)
(command pt)
)
)
(command "" "" "")
(setq pt1 pt)
(SETVAR "OSMODE" OLDOS)
)
)
)
)
)
(SETVAR "OSMODE" OLDOS)
(setvar "cmdecho" OLDCMD)
)

(defun c:blx (/ boch pt pt1 pt2 pt3 dist lis ang0 ang) 
  (SETQ OLDOS (GETVAR "OSMODE")) 
  (if (= bofu nil) 
    (setq bofu1 20) 
  ) 
  (if (= bochang nil) 
    (setq bochang1 50) 
  ) 
  (if (/= (setq oldcmd (getvar "cmdecho")) 0) 
    (setvar "cmdecho" 0) 
  ) 
  (prompt "\n请输入波幅<") 
  (princ bofu1) 
  (if (= (setq bofu (getreal ">:")) nil) 
    (setq bofu bofu1) 
    (setq bofu1 bofu) 
  ) 
  (prompt "\n请输入波长<") 
  (princ bochang1) 
  (if (= (setq bochang (getreal ">:")) nil) 
    (setq bochang bochang1) 
    (setq bochang1 bochang) 
  ) 
  (initget "Yes No") 
  (setq id (getkword "\n是否重新计算波长？Yes [No]:")) 
  (if (= id nil) 
    (setq id "No") 
  ) 
  (if (setq pt1 (getpoint "\n开始画波浪线(回车退出):")) 
    (progn 
      (while (setq pt2 (getpoint pt1 "\n下一点(回车退出):")) 
        (setq dist (distance pt1 pt2)) 
        (setq ang0 (angle pt1 pt2)) 
        (setq n (fix (/ dist bochang))) 
        (while (= n 0) 
          (prompt "\n该段长度比波长小，请重新输入:") 
          (setq pt2 (getpoint pt1 "\n下一点(回车退出):")) 
          (if (/= pt2 nil) 
            (progn 
              (setq dist (distance pt1 pt2)) 
              (setq ang0 (angle pt1 pt2)) 
              (setq n (fix (/ dist bochang))) 
            ) 
            (setq n nil) 
          ) 
        ) 
        (if (/= pt2 nil) 
          (progn 
            (if        (= id "No") 
              (setq boch (/ bochang 4)) 
              (setq boch (/ dist (* n 4)))              
            ) 
            (setq dist (sqrt (+ (* boch boch) (* bofu bofu)))) 
            (setq lis (list (atan bofu boch) 
                            (- 0 (atan bofu boch)) 
                            (- 0 (atan bofu boch)) 
                            (atan bofu boch) 
                      ) 
            ) 
            (setq pt3 pt1) 
            (IF        (< (- OLDOS 16384) 0) 
              (SETVAR "OSMODE" (+ OLDOS 16384)) 
            ) 
            (command "spline" pt1) 
            (repeat n 
              (foreach ang lis 
                (setq pt (polar pt3 (+ ang0 ang) dist)) 
                (setq pt3 pt) 
                (command pt) 
              ) 
            ) 
            (command "" "" "") 
            (setq pt1 pt) 
            (SETVAR "OSMODE" OLDOS) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (SETVAR "OSMODE" OLDOS) 
  (setvar "cmdecho" OLDCMD) 
)

cy956 · 发表于 2003-11-12 11:59:30

最初由刻录机发布
[B]绘制波浪线的LSP源程序!供大家分享顺便评评看实用不?
不过我一直在用.
[code]

(defun c:blx(/ lay os orth pt1 pt2 pt3 pt sel ang ang0 dist lis)
(setq lay (getvar "clayer"))
(setq os (getvar "osmode")... [/B]

建议你用entmake,可以随意图层,新加旧引很方便.
你可以搜寻cy956的旧贴,专门针对entmake的.

陌生人 · 发表于 2003-11-16 01:22:51

建议 getreal 改为 getdist
另外试了一下,发现画出来的波长比实际的短 (测试时总长不是波长的倍数)
修改后的程序可以画到头,但是波长会变更短

zhynt · 发表于 2003-11-18 09:19:02

最初由陌生人发布
[B]建议 getreal 改为 getdist
另外试了一下,发现画出来的波长比实际的短 (测试时总长不是波长的倍数)
修改后的程序可以画到头,但是波长会变更短 [/B]

我在说明中不是已经说了吗？为此我加上了是否重新计算波长的选项。

陌生人 · 发表于 2003-11-18 12:43:42

很感兴趣的是: 这个程序,楼主一般用在什么地方呢?

ahlzl · 发表于 2003-11-28 23:05:13

我也写了两个程序,请各位PP.
VLISP:

(defun c:blx ( / mspace pt1 pt2 p1 p2 pt ptt pt11 p0 n a b c e f h tmp myobj)
(vl-load-com)
(setq mspace (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object))))
(setq pt1 (getpoint "\请输入起点: "))
(setq p1 (list (car pt1)(cadr pt1)))
(terpri)
(setq pt2 (getpoint pt1 "\请输入终点: "))
(setq p2 (list (car pt2)(cadr pt2)))
(setq L (distance pt1 pt2))
(setq b (angle p1 p2))
(terpri)
(setq n (getint "\请输入踏步阶数："))
(terpri)
(setq h (getdist pt1 "\请输入波浪线的幅度:"))
(setq a (* 2 n))
(setq p0 p1)
(repeat a
(setq pt11 (polar p0 b (/ L a)))
(setq pt (append pt pt11))
(setq p0 pt11)
(setq ptt pt)
)
(setq ptt (append p1 ptt))
(setq tmp (vlax-make-safearray vlax-vbDouble(cons 0 (- (length ptt) 1))))
(vlax-safearray-fill tmp ptt)
(setq myobj (vla-addlightweightpolyline mspace tmp))
(setq c (/ (* 4 n h) L))
(setq e 0 )
(while (<= e (- a 1))
(setq f (+ e 1))
(vla-SetBulge myobj e (- 0 c))
(vla-setbulge myobj f c)
(setq e (+ e 2))
(setq f (+ f 2))
)
(princ)
)

(defun c:blx ( / mspace pt1 pt2 p1 p2 pt ptt pt11 p0 n a b c e f h tmp myobj) 
  (vl-load-com) 
  (setq mspace (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object)))) 
  (setq pt1 (getpoint "\请输入起点: ")) 
  (setq p1 (list (car pt1)(cadr pt1))) 
  (terpri) 
  (setq pt2 (getpoint pt1 "\请输入终点: ")) 
  (setq p2 (list (car pt2)(cadr pt2))) 
  (setq L (distance pt1 pt2)) 
  (setq b (angle p1 p2)) 
  (terpri) 
  (setq n (getint "\请输入踏步阶数：")) 
  (terpri) 
  (setq h (getdist pt1 "\请输入波浪线的幅度:")) 
  (setq a (* 2 n)) 
  (setq p0 p1) 
 
  (repeat a 
    (setq pt11 (polar p0 b (/ L a))) 
    (setq pt (append pt pt11)) 
    (setq p0 pt11) 
    (setq ptt pt) 
  ) 
   (setq ptt (append p1 ptt)) 
   (setq tmp (vlax-make-safearray vlax-vbDouble(cons 0 (- (length ptt) 1)))) 
   (vlax-safearray-fill tmp ptt) 
   (setq myobj (vla-addlightweightpolyline mspace tmp)) 
 
   (setq c (/ (* 4 n h) L)) 
   (setq e 0 ) 
   (while (<= e (- a 1)) 
     (setq f (+ e 1)) 
     (vla-SetBulge myobj e (- 0 c)) 
     (vla-setbulge myobj f c) 
     (setq e (+ e 2)) 
     (setq f (+ f 2)) 
   ) 
(princ) 
 )

VBA:

Sub blx()
Dim blx As AcadLWPolyline
Dim points() As Double
Dim a, n As Long
Dim L, h, c As Double
Dim pa, pb As Variant
Const PI = 3.1415926535
pa = ThisDrawing.Utility.GetPoint(, "请输入波浪线起点：")
pb = ThisDrawing.Utility.GetPoint(pa, "请输入波浪线终点：")
n = ThisDrawing.Utility.GetReal("请输入波浪线周波数:")
h = ThisDrawing.Utility.GetDistance(pa, "请输入波浪线的幅度:")
ReDim points(0 To 4 * n + 1) As Double
L = dis(pa, pb)
b = ThisDrawing.Utility.AngleFromXAxis(pa, pb)
c = 4 * n * h / L
For a = 0 To 4 * n + 1 Step 2
points(a) = pa(0) + (0.25 * a / n) * L * Cos(b)
points(a + 1) = pa(1) + (0.25 * a / n) * L * Sin(b)
Next
Set blx = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
For a = 0 To 2 * n - 1 Step 2
blx.SetBulge a, -c
blx.SetBulge a + 1, c
Next
End Sub
Function dis(pa, pb As Variant) As Double
dis = ((pa(0) - pb(0)) ^ 2 + (pa(1) - pb(1)) ^ 2) ^ 0.5
End Function

Sub blx() 
Dim blx As AcadLWPolyline 
Dim points() As Double 
Dim a, n As Long 
Dim L, h, c As Double 
Dim pa, pb As Variant 
Const PI = 3.1415926535 
 
pa = ThisDrawing.Utility.GetPoint(, "请输入波浪线起点：") 
pb = ThisDrawing.Utility.GetPoint(pa, "请输入波浪线终点：") 
n = ThisDrawing.Utility.GetReal("请输入波浪线周波数:") 
h = ThisDrawing.Utility.GetDistance(pa, "请输入波浪线的幅度:") 
ReDim points(0 To 4 * n + 1) As Double 
L = dis(pa, pb) 
b = ThisDrawing.Utility.AngleFromXAxis(pa, pb) 
c = 4 * n * h / L 
 
For a = 0 To 4 * n + 1 Step 2 
points(a) = pa(0) + (0.25 * a / n) * L * Cos(b) 
points(a + 1) = pa(1) + (0.25 * a / n) * L * Sin(b) 
Next 
Set blx = ThisDrawing.ModelSpace.AddLightWeightPolyline(points) 
 
For a = 0 To 2 * n - 1 Step 2 
blx.SetBulge a, -c 
blx.SetBulge a + 1, c 
Next 
 
End Sub 
Function dis(pa, pb As Variant) As Double 
dis = ((pa(0) - pb(0)) ^ 2 + (pa(1) - pb(1)) ^ 2) ^ 0.5 
End Function

刻录机 · 发表于 2003-11-30 10:35:28

多谢zhynt对波长控制的补充,但加载使用取点时有些不便,不知你以为如何?
(斑竹对我的源程序好像不屑一顾?不然怎么没有表示,我很少花精力做LISP,所以这样的分享很难得啊?!)

陌生人 · 发表于 2003-11-30 12:13:02

哈哈,我鼓励你一下,谢谢
呃,错了. 是不用谢 :)

zhynt · 发表于 2003-12-1 08:37:40

最初由刻录机发布
[B]多谢zhynt对波长控制的补充,但加载使用取点时有些不便,不知你以为如何?
(斑竹对我的源程序好像不屑一顾?不然怎么没有表示,我很少花精力做LISP,所以这样的分享很难得啊?!) [/B]

怎么这样说？我的程序就是在你的程序基础上该的，怎么是不屑一顾？不是怪我没有给你加分吧。

刻录机 · 发表于 2003-12-1 16:44:55

最初由 zhynt 发布
[B][QUOTE]最初由刻录机发布
[[/B... [/B]

对于一个不是很精通LISP的,却做来了LISP源程序,能没有这样的想法吗?,希望你能体谅!

wharan · 发表于 2003-12-1 16:49:50

如果仅仅要的是一种波浪形状，用程序画图不如直接做一个波浪线型，具有线型的一切特征，修改起来又方便。

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

[分享]：波浪线绘制的LSP源程序!

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

相关帖子

Re: [分享]：波浪线绘制的LSP源程序!