大家好，
这是我的Lisp程序。它执行以下操作：
1） 将云线批注添加到多个图元中
2） 添加图层（或根据需要创建并添加特性）
3） 添加图案填充
4） 插入引线和文字的块（已格式化）
我对lisp的了解非常有限。正如你所见，我复制了几个不同的代码，并将其组合在一起，使其适用于我的应用程序。这是可行的，但我知道这一点也不系统。我不知道我的错误处理是否正确。
我想补充的一件事是，如果修订云太大或太小，它应该允许在不关闭和撤消所有内容的情况下这样做。从另一个意义上讲，我需要在此中撤消和重置弧长选项。有人能帮我吗？
-
- (defun c:RVC6 (/ *error* oce mflag ans)
- ;************************************Error handling*********************************************
- (defun *error* (msg)
- (setvar "cmdecho" OCE)
- (setq *error* nil)
- (princ "\nRevision cloud program is done.")
- (princ)
- )
- ;************************************Program begins*********************************************
- (setq OCE (getvar "cmdecho")
- OOS (getvar "osmode")
- )
- (setvar "cmdecho" 0)
- (setq mflag nil)
- (while (not mflag)
- (prompt "\n*** Enter option C, H, L, or E ***")
- (initget 0 "Cloud Hatch Leader Exit")
- (setq Ans (getkword "\nconvert to revision Cloud/Hatch/Leader/<Exit>: "))
- (if (= Ans nil)
- (setq Ans "Exit")
- ) ;end if
- (cond
- ( (= Ans "Cloud")
- (convcloud)
- )
- ( (= Ans "Hatch")
- (Addhatch)
- )
- ( (= Ans "Leader")
- (Addleader)
- )
- ( (= Ans "Exit")
- (setvar "cmdecho" OCE)
- (setvar "osmode" OOS)
- (quit)
- )
- ) ;end cond
- );end while
- );end defun
- ;************************************Program ends**********************************************
- ;*******************************Start of "convcloud" program***********************************
- (defun convcloud (/ al ss)
- (initget (+ 2 4))
- (setq al (getreal "Specify Arc length <0.5>:"))
- (if (= al nil) ;If user do not input a value here
- (setq al 0.5) ;Consider "Enter" as 0.5
- ) ; end if
- (if (setq ss (ssget '((0 . "LINE,*POLYLINE,CIRCLE,ELLIPSE,SPLINE,ARC"))))
- (progn
- (repeat (setq i (sslength ss))
- (command "_.revcloud" "a" al al "" (ssname ss (setq i (1- i))) "")
- (if
- (not (tblsearch "LAYER" "CONSTRUCTION"))
- (command "-layer" "N" "CONSTRUCTION" "C" "1" "CONSTRUCTION" "LT" "continuous" "CONSTRUCTION" "")
- ) ; end if
- (command ".-layer" "S" "CONSTRUCTION" "C" "red" "" "")
- (Command "Chprop" "l" "" "la" "CONSTRUCTION" "C" "BYLAYER" "Lt" "BYLAYER" "LW" "BYLAYER" "")
- );end repeat
- (princ "\nRevision cloud(s) created on CONSTRUCTION layer.")
- );end progn
- (princ "\nNo objects selected.")
- )
- );end defun
- ;*******************************End of "convcloud" program*************************************
- ;*****************************Start of "Addhatch" Program *************************************
- (defun Addhatch (/ htype selset thisobj setlen entname)
-
- (initget 1 "D R")
- (setq htype (getkword "\nSpecify hatch type? Demo(D)/Rebuild(R):"))
-
- (if (= htype "D")
- (setq htype "ANSI31")
- ) ;end if
-
- (if (= htype "R")
- (setq htype "DOTS")
- ) ;end if
- (princ "\nSelect object(s) to hatch:")
- (setq selset (ssget))
- (if selset
- (progn
- (setq thisobj 0)
- (setq setlen (sslength selset))
- (while (< thisobj setlen )
- (setq entname(ssname selset thisobj))
- (Command "-bhatch" "Advanced" "Style" "Outer" "" "")
- (command "-bhatch" "p" htype "3" "" "s" entname "" "")
- (if
- (not (tblsearch "LAYER" "CONSTRUCTION"))
- (command "-layer" "N" "CONSTRUCTION" "C" "1" "CONSTRUCTION" "LT" "continuous" "CONSTRUCTION" "")
- ) ; end if
- (command ".-layer" "S" "CONSTRUCTION" "C" "red" "" "")
- (Command "Chprop" "l" "" "la" "CONSTRUCTION" "C" "BYLAYER" "Lt" "BYLAYER" "LW" "BYLAYER" "")
- (setq thisobj(+ thisobj 1))
- ) ; end while
- (alert "\n ***WARNING***
- Hatching could not skip the inner objects.
- To solve this, Double click hatch and `Add: select objects'
- and select inner object & click OK")
- ) ; end progn
- ) ;end if selset
- (princ "\nNo objects selected.")
- );end defun
- ;*******************************End of "Addhatch" program*************************************
- ;*****************************Start of "Addleader" Program ***********************************
- (defun Addleader (/ pt1)
- (while
- (setq pt1 (getpoint "\nInserting task description note, Specify Arrow End Point or hit Enter to close:"))
- (Command "_INSERT" "CP TEXT" pt1 "" "" "")
- (command "explode" "l")
- );end while
| 
