求一个简单lisp程序

(princ "\n加载成功，快捷键 “zb”启动！坐标数据存至“d:\坐标txt”")

(defun c:zb( / ss1 sslen num file str start end sx sy ex ey)

(setq ss1 (ssget '((0 "LINE")))

sslen (sslength ss1)

num 0

)

(setq file(open "d:\\坐标txt" "w"))

(close file)

(repeat sslen

(progn

(setq str (entget (ssname ss1 num))

start (cdr (assoc 10 str))

end (cdr (assoc 11 str))

sx (car start)

sy (cadr start)

ex (car end)

ey (cadr end)

num (1+ num)

)

(write-file "d:\\坐标txt" "Line ")

(write-file "d:\\坐标txt" num)

(write-file "d:\\坐标txt" " :\n")

(write-file "d:\\坐标txt" (rtos sx 2 4))

(write-file "d:\\坐标txt" " ")

(write-file "d:\\坐标txt" (rtos sy 2 4))

(write-file "d:\\坐标txt" " ")

(write-file "d:\\坐标txt" (rtos ex 2 4))

(write-file "d:\\坐标txt" " ")

(write-file "d:\\坐标txt" (rtos ey 2 4))

(write-file "d:\\坐标txt" "\n\n")

)

)

(setq ss1 nil)

)

(defun write-file (filename content)

(setq stream (open filename "a")

)

(princ content stream)

(close stream)

)

可以用反应器实现，前提是画线和输入文字必须用定义的函数一次性 *** 作完成LISP代码如下：

(VL-Load-Com)

(defun c:Line_Txt(/ Pt Pt1 Pt2 EntLine HandTxt VlaObj Tmp)

(setq Pt1 (getpoint "\n指定第一点:"))

(setq Pt2 (getpoint "\n指定下一点:"))

(setq Pt (list (/ (+ (car Pt1) (car Pt2)) 2) (/ (+ (cadr Pt1) (cadr Pt2)) 2) (/ (+ (caddr Pt1) (caddr Pt2)) 2)))

(command "_Line" Pt1 Pt2 "")

(setq EntLine (entlast))

(setq VlaObj (cons (VLAX-EName->VLA-Object EntLine) '()));;将直线转换为VLA对象

(setq HandTxt '((0 "TEXT"))

HandTxt (append HandTxt (list (append '(10) Pt1)))

HandTxt (append HandTxt (list (append '(11) Pt)))

HandTxt (append HandTxt (list (cons 40 (getdist "\n指定高度:"))))

HandTxt (append HandTxt (list (cons 72 1)))

HandTxt (append HandTxt (list (cons 73 0)))

HandTxt (append HandTxt (list (cons 50 (angle pt1 Pt2))))

HandTxt (append HandTxt (list (cons 1 (getstring "\n输入文字:>")))))

(entmake HandTxt)

(setq HandTxt (cdr (Assoc 5 (entget (entlast)))))

(VLR-Pers (VLR-Object-Reactor vlaObj HandTxt '((:vlr-modified LineModefy))))

)

(defun LineModefy(EntLine EntTxt parameter-list / Pt Pt1 Pt2)

(setq EntTxt (entget (HandEnt (VLR-Data EntTxt))))

(setq EntLine (entget (VLAX-VLA-Object->EName EntLine)))

(setq Pt1 (cdr (assoc 10 EntLine)) Pt2 (cdr (assoc 11 EntLine)))

(setq Pt (list (/ (+ (car Pt1) (car Pt2)) 2) (/ (+ (cadr Pt1) (cadr Pt2)) 2) (/ (+ (caddr Pt1) (caddr Pt2)) 2)))

(setq EntTxt (subst (cons 50 (angle Pt1 Pt2)) (assoc 50 EntTxt) EntTxt)

EntTxt (subst (append '(10) Pt1) (assoc 10 EntTxt) EntTxt)

EntTxt (subst (append '(11) Pt) (assoc 11 EntTxt) EntTxt))

(entmod EntTxt)

)

也可以用属性块实现，将文字与直线定义成属性块，打开块编辑器，在参数选项板中设定点参数和旋转参数，在动作选项板中定义要执行的动作，……，具体的自己参照属性块的做吧。

以上就是关于求一个简单lisp程序全部的内容，包括:求一个简单lisp程序、cad lisp程序、等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！