上一回谈及的基础概念太多，不够务实，本次开始直奔主题，
用到什么学什么。
介绍上一回末尾的小问题，来讲解car，cdr，defun，cond
问题：如何实现将多层嵌套的列表展开成一级列表，如：
((1.3 2.3 -2.1) "P13SH" ("GSt11" "AIR COND") 14.34)变成
(1.3 2.3 -2.1 "P13SH" "GSt11" "AIR COND" 14.34)
==========================================================
(defun flatten(seq)
(cond
((null seq) ())
((listp seq) (append (flatten (car seq)) (flatten (cdr seq))))
(t (list seq))
)
)
===========================================================
问题：选定两个点，就能够做出一条线和一行垂直文字“Just Do It”
===========================================================
(defun c:tt()
(setq bpt (getpoint "选择起点"))
(setq ept (getpoint "选择终点"))
(command "line" bpt ept "")
(command "text" "j" "ml" ept 3.5 90 "Just Do It")
)
============================================================
问题：绘制序号标注
============================================================
(defun c:tt_x1()
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode")
(setq dd (getdist "\n 正方形边长<10>:"))
(if (null num) (setq num1))
(setq dd2 (/ dd 5))
(setq pt1 (getpoint pt1 "\n 第一点："))
(while (/= pt1 nil)
(command "donut" 0 dd2 pt1 "")
(setq pt2 (getpoint pt1 "\n 第二点："))
(command "line" pt1 pt2 "")
(command "polygon" 4 "e" pt2 (polar pt2 0 dd))
(setq en2 (entlast))
(command "text" "m" (polar (polar pt2 0 (/ dd 2)) (/ pi 2) (/ dd 2)) (/ dd 2) 0 (itoa num))
(setq en2 (entlast))
(setq pp1 pt2)
(setq pp2 (polar pp1 0 dd))
(setq pp3 (polar pp2 (/ pi 2) dd))
(setq pp4 (polar pp1 (/ pi 2) dd))
(setq pp_0 (polar pp1 (/ pi 2) (/ dd 2)))
(setq pp_90 (polar pp1 0 (/ dd 2)))
(setq pp_180 (polar pp2 (/ pi 2) (/ dd 2)))
(setq pp_270 (polar pp3 pi (/ dd 2)))
(setq pp pt2)
(setq ang (angle pt1 pt2))
(cond ((and (> ang (* pi 0.5)) (< ang pi)) (setq pp pp2))
((and (> ang pi) (< ang (* pi 1.5))) (setq pp pp3))
((and (> ang (* pi 1.5)) (< ang (* pi 2))) (setq pp pp4))
)
(cond ((= ang 0) (setq pp pp_0))
((= ang (/ pi 2)) (setq pp pp_90))
((= ang pi) (setq pp pp_180))
((= ang (* pi 1.5)) (setq pp pp_270))
)
(command "move" en1 en2 "" pp pt2)
(setq num (1+ num))
(setq pt1 (getpoint "\n 第一点"))
)
(setvar "osmode" os)
(prin1)
)
=============================================================
问题：样条转多段线（from boxiong chen）
(defun c:ASpline()
(defun SEpoint(sen)
(setq sel (entget sen) snn 0 spl '())
(while (setq spp (nth snn sel))
(if (= 10 (car spp))
(setq spl (cons (cdr spp) spl))
)
(setq snn (1+ snn))
)
(list (last spl) (car spl))
)
(setq se (car (entsel "\nA spline: "))
sn (getdist "\nlength of lines: ")
sp (SEpoint se)
sc (getvar "cecolor")
)
(command "color" 123 "measure" (list se (cdr (car sp))) sn)
(setq ss (ssget "X" '((62 . 123)(0 . "POINT")))
sn (sslength ss)
snn (1- sn)
)
(command "color" sc "3dpoly" (car sp))
(repeat sn
(setq spn (ssname ss snn))
(setq sdp (cdr (assoc 10 (entget spn))))
(setq snn (1- snn))
(entdel spn)
(command sdp)
)
(command (cadr sp) "")
(entdel se)
(princ)
)
思考：CAGD方法与宏录制实现 (from AfraLisp)
(defun C:MACRO (/ str1 macro macname)
(setq macro '(command))
;start list with command
(setq macname (getstring "\nEnter name of macro: "))
;get name of macro
(while (/= str1 "/")
;do while str1 not equal to /
(setq str1 (getstring "\nEnter macro or / to exit: " ))
;get keystrokes
(if (= str1 "/")
(princ "\nEnd of macro ")
;if / then print message
(Setq macro (append macro (list str1)))
;else append keystrokes to list
)
;end if macro list
)
;end while
(eval (list 'defun (read macname) '() macro))
;create function
(princ)
)
;end macro
//侵删
网友评论