[求助]编一个类似于revcloud--“云彩“的lisp

jaminth

编一个类似于revcloud--“云彩“的lisp ,求各位斑主帮帮忙,,,或给出关键代码也行!

ZZXXQQ

不明白如何类似？ACAD有源码呀！

3. (Defun C:REVCLOUD (/
4. ARC_DIST   ;;radius of included arc
5. INC_ANGLE  ;;included angle in degrees
6. LAST_PT    ;;the last point just entered/shown
7. START_PT   ;;where the cloud began
8. NEXT_PT    ;;where we are going next
9. TMP        ;;tempory holder for radius of bulge
10. )
11. (init_bonus_error
12. (List
13. (List "cmdecho" 0
14. "blipmode" 0
15. "osmode" 0
16. )
17. T     ;flag. True means use undo for error clean up.  
18. ) ;list
19. ) ;init_bonus_error
20. (Setq INC_ANGLE 110)
21. (if (and
22. (/= ""  (getcfg "AppData/AC_Bonus/Revcld_Bulge"))
23. (/= nil (getcfg "AppData/AC_Bonus/Revcld_Bulge"))
24. )
25. (setq ARC_DIST (atof (getcfg "AppData/AC_Bonus/Revcld_Bulge")))
26. (if (= (getvar "DIMSCALE") 0)
27. (setq ARC_DIST 0.375)
28. (setq ARC_DIST (* 0.375 (getvar "DIMSCALE")))
29. )
30. );end if
31. (prompt (strcat "\n弧长设置在 " (rtos ARC_DIST 2 3)))
32. (initget "Arc")
33. (setq LAST_PT (GetPoint "\n弧长(Arc length)/<选择云的起点(Pick cloud starting point)>: "))
34. (if (= LAST_PT "Arc")
35. (progn
36. (initget 6)
37. (setq TMP (getdist (strcat "\n弧长(Arc length) <" (rtos ARC_DIST 2 3) ">: ")))
38. (if TMP
39. (Progn
40. (setq ARC_DIST TMP)
41. (setcfg "AppData/AC_Bonus/Revcld_Bulge" (rtos ARC_DIST))
42. )
43. )
44. (setq LAST_PT (getpoint "\n选择云的起点(Pick cloud start point): "))
45. ) ;;end STR "RADIUS" test
46. )
47. (if LAST_PT (progn  ;;start up the cloud generator...
48. (setq START_PT LAST_PT
49. SAVED_EN (entlast))
50. (Prompt "\n 沿云的路径做出阴影(Guide crosshairs along cloud path)...")
51. (Command
52. "_.pline"     ;draw cloud as a polyline on current layer
53. LAST_PT
54. "_a"         ;specify arc option
55. "_a"         ;specify angle option
56. INC_ANGLE    ;included angle
57. )
58. )) ;end IF LAST_PT
59. (While LAST_PT  ;;as long as we have a last point value,
60. (Setq NEXT_PT (GrRead 1)     ;;real time read
61. READTYP (car NEXT_PT)
62. )
63. (if (or (=  5 READTYP) (= READTYP 3)) ;;read a position or a pick?
64. (progn
65. (setq NEXT_PT (cadr NEXT_PT))
66. (If (or (> (Distance LAST_PT NEXT_PT) ARC_DIST) (= READTYP 3))
67. (Progn
68. (Command NEXT_PT "_a" INC_ANGLE)
69. (Setq LAST_PT NEXT_PT)
70. )
71. )
72. (If (>
73. (Distance LAST_PT NEXT_PT)
74. (Distance START_PT NEXT_PT)
75. )
76. (Progn
77. (Command START_PT "_cl")
78. (Setq LAST_PT Nil)
79. (prompt "\n云完成(Cloud finished).")
80. )
81. )
82. )
83. (prompt "\n移动鼠标画云(Move the pointer to draw the cloud)")
84. );End if
85. );End while
86. (restore_old_error)
87. (Princ)
88. ) ;end cloud.lsp
89. (Defun c:RCHELP (/)
90. (prompt "   这个修正的画云程序沿用户指定的路径画凸复合线.\n")
91. (prompt "   闭合这个云, \n")
92. (prompt "   简单的回到起点\n")
93. (prompt "   云的弧长能够在开始指定,用键盘输入 \n")
94. (prompt "   指定 A 为 圆弧, 输入一个长度或选择两点.\n")
95. (textscr)
96. (princ)
97. )
98. (Prompt "   REVCLOUD 调入. 键入 REVCLOUD 开始画云,\n")
99. (prompt "   闭合云, 回到起点t. 更多的帮助 - RCHELP")
100. (Princ)
101. (Princ)

(Defun C:REVCLOUD (/ ARC_DIST   ;;radius of included arc INC_ANGLE  ;;included angle in degrees LAST_PT    ;;the last point just entered/shown START_PT   ;;where the cloud began NEXT_PT    ;;where we are going next TMP        ;;tempory holder for radius of bulge ) (init_bonus_error (List (List "cmdecho" 0 "blipmode" 0 "osmode" 0 ) T     ;flag. True means use undo for error clean up.   ) ;list ) ;init_bonus_error (Setq INC_ANGLE 110) (if (and (/= ""  (getcfg "AppData/AC_Bonus/Revcld_Bulge")) (/= nil (getcfg "AppData/AC_Bonus/Revcld_Bulge")) ) (setq ARC_DIST (atof (getcfg "AppData/AC_Bonus/Revcld_Bulge"))) (if (= (getvar "DIMSCALE") 0) (setq ARC_DIST 0.375) (setq ARC_DIST (* 0.375 (getvar "DIMSCALE"))) ) );end if (prompt (strcat "\n弧长设置在 " (rtos ARC_DIST 2 3))) (initget "Arc") (setq LAST_PT (GetPoint "\n弧长(Arc length)/<选择云的起点(Pick cloud starting point)>: ")) (if (= LAST_PT "Arc") (progn (initget 6) (setq TMP (getdist (strcat "\n弧长(Arc length) <" (rtos ARC_DIST 2 3) ">: "))) (if TMP (Progn (setq ARC_DIST TMP) (setcfg "AppData/AC_Bonus/Revcld_Bulge" (rtos ARC_DIST)) ) ) (setq LAST_PT (getpoint "\n选择云的起点(Pick cloud start point): ")) ) ;;end STR "RADIUS" test ) (if LAST_PT (progn  ;;start up the cloud generator... (setq START_PT LAST_PT SAVED_EN (entlast)) (Prompt "\n 沿云的路径做出阴影(Guide crosshairs along cloud path)...") (Command "_.pline"     ;draw cloud as a polyline on current layer LAST_PT "_a"         ;specify arc option "_a"         ;specify angle option INC_ANGLE    ;included angle ) )) ;end IF LAST_PT (While LAST_PT  ;;as long as we have a last point value, (Setq NEXT_PT (GrRead 1)     ;;real time read READTYP (car NEXT_PT) ) (if (or (=  5 READTYP) (= READTYP 3)) ;;read a position or a pick? (progn (setq NEXT_PT (cadr NEXT_PT)) (If (or (> (Distance LAST_PT NEXT_PT) ARC_DIST) (= READTYP 3)) (Progn (Command NEXT_PT "_a" INC_ANGLE) (Setq LAST_PT NEXT_PT) ) ) (If (> (Distance LAST_PT NEXT_PT) (Distance START_PT NEXT_PT) ) (Progn (Command START_PT "_cl") (Setq LAST_PT Nil) (prompt "\n云完成(Cloud finished).") ) ) ) (prompt "\n移动鼠标画云(Move the pointer to draw the cloud)") );End if );End while (restore_old_error) (Princ) ) ;end cloud.lsp (Defun c:RCHELP (/) (prompt "   这个修正的画云程序沿用户指定的路径画凸复合线.\n") (prompt "   闭合这个云, \n") (prompt "   简单的回到起点\n") (prompt "   云的弧长能够在开始指定,用键盘输入 \n") (prompt "   指定 A 为 圆弧, 输入一个长度或选择两点.\n") (textscr) (princ) ) (Prompt "   REVCLOUD 调入. 键入 REVCLOUD 开始画云,\n") (prompt "   闭合云, 回到起点t. 更多的帮助 - RCHELP") (Princ) (Princ)

jaminth

我想自己编一个简单的圈云程序..不想调用EXPRESS文件下的 acetutil.arx/acetutil.fas,,,,,,,,恳请版主帮忙!我找到[color="#ff0000"]meflying版主编的几行关键代码,可是我想要画出来的是圆弧，不是一段段的线,恳请ZZXXQQ帮一下忙!

2. (defun c:test( / pt)
3. (setq pt (getpoint "\nEnter the first point:"))
4. (if pt
5. (progn
6. (command "_.pline" pt)
7. (while (= (car (setq pt (grread 5))) 5)
8. (command (cadr pt))
9. )
10. (command "")
11. )
12. )
13. (princ)
14. )

(defun c:test( / pt) (setq pt (getpoint "\nEnter the first point:")) (if pt (progn (command "_.pline" pt) (while (= (car (setq pt (grread 5))) 5) (command (cadr pt)) ) (command "") ) ) (princ) )

ZZXXQQ

2楼的代码不行吗?

jaminth

我真正的目的是:

自己正在编的一个LISP中,有一项是要实现画"云彩"的功能,但不想调用express的 acetutil函数,只想简单的画"云彩"功能.

谢谢!

ZZXXQQ

可二楼代码没调用ET的acetutil函数呀！

jaminth

运行之后,出现这样的错误提示:

no function definition: INIT_BONUS_ERROR

jaminth

能否加一个功能：＂能够画出＂calligraphy＂的效果＂！

ZZXXQQ

试试：

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

jaminth

谢谢!＂calligraphy＂的效果我自己昨晚也已经解决了.不过您提供的这个LISP,总是不能正解退出循环的？！！还有感觉就是程序中有些不必要的代码存在！斑主能否也一并解决一下．