怎么简化代码

gare1000 · 发表于 2004-4-29 21:21:00

这是我写的一个画一些水平方向平行的线，我觉得太罗嗦了，怎么样可以简化一些吗？;------------这个文件主要是画一些部件的主视图------------------;画一段机架返回该机架的起点和终点到左边的距离
(defun CrawQ/TY25D1XX-jj (PBase1 PBase2 LDAll P0 W ViewSel TypeChain
   / p1 p2 HalfWidth
   List-Cen-Date List-DN-Date list-0-Date Num)
   Base1 本段机架主视图的基点.
   Base2 本段机架俯视图的基点.
   ;LDAll 本段机架的长度.
   0 图纸的基点.
   ;HalfWidth 机架内面的半宽.
   ;ViewSel 视图选择 = 1 只画主视图 = 2 只画俯视图 = 3 都画.
   ;TypeChain 链条位置类型，(内外链类型).
   (setq LDAll (float LDAll)
W (float W)
   )
(if (or (= ViewSel 1) (= ViewSel 3))
   ;-------------画主视图机架-------------
   ;画3条中心线.
   (progn
   (command "layer" "s" "cen" "")
   (setq p1 (mapcar '+ PBase1 (list 0 14.5)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 14.5)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 127.5)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 127.5)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 159.82)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 159.82)))
   (command "line" P1 P2 "")
   ;画DA层的线3条
   (command "layer" "s" "DA" "")
   (setq p1 (mapcar '+ PBase1 (list 0 3)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 3)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 136)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 136)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 139)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 139)))
   (command "line" P1 P2 "")
   ;画0层的线11条
   (command "layer" "s" "0" "")
   (setq p1 (mapcar '+ PBase1 (list 0 0)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 0)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 10)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 10)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 19)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 19)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 29.09)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 29.09)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 35.1)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 35.1)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 104.4)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 104.4)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 112.91)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 112.91)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 123)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 123)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 132)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 132)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 142)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 142)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 147)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 147)))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase1 (list 0 154)))
   (setq p2 (mapcar '+ PBase1 (list LDAll 154)))
   (command "line" P1 P2 "")
   )
)
   ;----------------------画俯视图的机架-----------------
   (if (= TypeChain "外")
   (setq List-Cen-Date '(57.5)
   List-DN-Date '(3 81 84)
   list-0-Date '(0 37 52 63 78 99.5)
   )
   (setq List-Cen-Date '(26.5)
   List-DN-Date '(3 81 84)
   list-0-Date '(0 6 21 32 47 99.5)
   )
   )

   (setq Num (length List-Cen-Date)
n 0
   )
   (repeat Num
   (setq Y-Value (+ HalfWidth (Nth n List-Cen-Date)))
   (setq p1 (mapcar '+ PBase2 (list 0    Y-Value)))
   (setq p2 (mapcar '+ PBase2 (list LDAll Y-Value)))
   (command "line" P1 P2 "")
   (setq n (+ n 1))
   )
(if (or (= ViewSel 2) (= ViewSel 3))
   (progn
   ;1 画后面的机架.
   (setq HalfWidth (/ (- W 199) 2))
   (if (= TypeChain "外" )
   (Progn
   ;画1条中心线.
   (command "layer" "s" "cen" "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 57.5)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 57.5)))))
   (command "line" P1 P2 "")
   (setq bbb (cdr p1))
   ;画3条虚线.
   (command "layer" "s" "DA" "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 3)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 3)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 81)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 81)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 84)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 84)))))
   (command "line" P1 P2 "")
   ;画6条实线.
   (command "layer" "s" "0" "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 0)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 0)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 37)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 37)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 52)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 52)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 63)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 63)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 78)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 78)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 99.5)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 99.5)))))
   (command "line" P1 P2 "")
   ;2 画前面的机架.
   ;画1条中心线.
   (command "layer" "s" "cen" "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 57.5)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 57.5)))))
   (command "line" P1 P2 "")
   ;画3条虚线.
   (command "layer" "s" "DA" "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 3)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 3)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 81)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 81)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 84)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 84)))))
   (command "line" P1 P2 "")
   ;画6条实线.
   (command "layer" "s" "0" "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 0)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 0)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 37)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 37)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 52)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 52)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 63)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 63)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 78)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 78)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 99.5)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 99.5)))))
   (command "line" P1 P2 "")
   )
   (Progn
   ;画1条中心线.
   (command "layer" "s" "cen" "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 26.5)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 26.5)))))
   (command "line" P1 P2 "")
   (setq bbb (cdr p1))
   ;画3条虚线.
   (command "layer" "s" "DA" "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 3)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 3)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 81)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 81)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 84)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 84)))))
   (command "line" P1 P2 "")
   ;画6条实线.
   (command "layer" "s" "0" "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 0)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 0)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 6)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 6)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 21)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 21)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 32)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 32)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 47)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 47)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (+ 0 (+ HalfWidth 99.5)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (+ 0 (+ HalfWidth 99.5)))))
   (command "line" P1 P2 "")
   ;2 画前面的机架.
   ;画1条中心线.
   (command "layer" "s" "cen" "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 26.5)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 26.5)))))
   (command "line" P1 P2 "")
   ;画3条虚线.
   (command "layer" "s" "DA" "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 3)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 3)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 81)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 81)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 84)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 84)))))
   (command "line" P1 P2 "")
   ;画6条实线.
   (command "layer" "s" "0" "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 0)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 0)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 6)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 6)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 21)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 21)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 32)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 32)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 47)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 47)))))
   (command "line" P1 P2 "")
   (setq p1 (mapcar '+ PBase2 (list 0 (- 0 (+ HalfWidth 99.5)))))
   (setq p2 (mapcar '+ PBase2 (list LDAll (- 0 (+ HalfWidth 99.5)))))
   (command "line" P1 P2 "")
   )
   )
   )
)

   ;返回的值.
   (list
(cons "Start" (- (car p1) (car p0)))
(cons "End" (- (car p2) (car p0)) )
)
)

秋枫 · 发表于 2004-4-30 20:21:00

其实能管用就行～～一味追求精简代码没有必要。
看到你用了很多Command函数，也许用Apply函数可能会精简一点。先创建一个列表，随便举个例子，比如 (setq plist (list pt1 pt2 pt3 pt4...))....
创建表的时候当然可以用循环什么的。。。。看程序啦
最后用一句
(apply 'command (cons "pline" plist))
(command "")
这样也许会简单一点～～仅供参考。