奥托李斯普——第二回

上一回谈及的基础概念太多,不够务实,本次开始直奔主题,

用到什么学什么。


介绍上一回末尾的小问题,来讲解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


//侵删

你可能感兴趣的:(奥托李斯普——第二回)