[编程交流] 寻找一个Lisp程序的人

Code in post below

(defun c:layerlegend (/ osm ortho clayer celtype cecolor start-point line-length text-height *error*)
(defun *error* (msg)
 (setvar "osmode" osm)
 (setvar "orthomode" ortho)
 (setvar "clayer" clayer)
 (setvar "celtype" celtype)
 (setvar "cecolor" cecolor)
 (princ msg)
)
(defun mfp (pt pa) (list (+ (car pt) (car pa)) (+ (cadr pt) (cadr pa)) (+ (caddr pt) (caddr pa))))
(setq osm (getvar "osmode"))
(setq ortho (getvar "orthomode"))
(setq clayer (getvar "clayer"))
(setq celtype (getvar "celtype"))
(setq cecolor (getvar "cecolor"))
(setq start-point (getpoint "\nSelect point to start legend: "))
(setvar "orthomode" 1)
(setq line-length (getdist start-point "\nEnter length of line or click end point: "))
(setq text-height (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
(setvar "osmode" 0)
(setvar "clayer" (cdr (assoc 2 (tblnext "Layer" T))))
(setvar "celtype" "ByLayer")
(setvar "cecolor" "ByLayer")
(command "_line" start-point (mfp start-point (list line-length 0 0)) "")
(command "-text" (mfp start-point (list 0 1 0)) "0" (getvar "clayer"))
(while (setq layer (tblnext "Layer"))
 (setvar "clayer" (cdr (assoc 2 layer)))
 (setq start-point (mfp start-point (list 0 (- 0 (+ text-height 4)) 0)))
 (command "_line" start-point (mfp start-point (list line-length 0 0)) "")
 (command "-text" (mfp start-point (list 0 1 0)) "0" (getvar "clayer"))
)
(setvar "osmode" osm)
(setvar "orthomode" ortho)
(setvar "clayer" clayer)
(setvar "celtype" celtype)
(setvar "cecolor" cecolor)
)