(defun c:ssel1 (/ sp d l n sc i sl np od p1 p2 tmp input)
(defun remove (expr lst);;;TonyT or VNesterowski
(apply 'append (subst nil (list expr) (mapcar 'list lst))))
(initget 1)
(setq sp (getpoint "\nStart Point: "))
(setq i 1)
(if sl_default (setq sl sl_default)
(progn
(initget 7)
(setq d (getdist "\nFirst Segment Diameter: "))
(initget 7)
(setq l (getdist "\nFirst Segment Length: "))
(setq sl (list (list i d l)))))
(while (/= input "Finish")
(textpage)
(setq n nil)
(princ "\nSegment\tDiameter\tLength")
(foreach s sl
(princ (strcat "\n" (itoa (nth 0 s)) "\t" (rtos (nth 1 s) 2 4) "\t\t" (rtos (nth 2 s) 2 4))))
(initget "Add Edit Remove Display Finish")
(setq input (getkword "\nAdd/Edit/Remove/Display/Finish - <Add>:"))
(or input (setq input "Add"))
(cond ((= input "Add")
(setq i (1+ i))
(initget 7)
(setq d (getdist "\nNext Segment Diameter: "))
(initget 7)
(setq l (getdist "\nNext Segment Length: "))
(setq sl (cons (list i d l) (reverse sl)))
(setq sl (reverse sl)))
((= input "Remove")
(while (or (not n)
(not (assoc n sl)))
(setq n (getint "\nSegment Number To Remove: ")))
(setq sl (remove (assoc n sl) sl))
(setq tmp nil sc 0)
(foreach p sl
(setq tmp (cons (list (setq sc (1+ sc)) (nth 1 p) (nth 2 p)) tmp)))
(setq sl (reverse tmp)
i sc))
((= input "Edit")
(while (or (not n)
(not (assoc n sl)))
(setq n (getint "\nSegment Number To Edit: ")))
(princ "\n") (prin1 (assoc n sl))
(initget 7)
(setq d (getdist "\nNew Segment Diameter: "))
(initget 7)
(setq l (getdist "\nNew Segment Length: "))
(setq sl (subst (list n d l) (assoc n sl) sl)))
((= input "Display")
(graphscr)
(setq od 0)
(setq np sp)
(foreach p sl
(setq p1 (polar np (* pi 0.5) (* (- (nth 1 p) od) 0.5))
p2 (polar p1 (* pi 1.0) (nth 2 p)))
(grdraw np p1 2 3)
(grdraw p1 p2 2 3)
(setq np p2
od (nth 1 p)))
(getstring "\nPress Enter to Continue...."))))
(graphscr)
(setq od 0
np sp)
(foreach p sl
(setq p1 (polar np (* pi 0.5) (* (- (nth 1 p) od) 0.5))
p2 (polar p1 (* pi 1.0) (nth 2 p)))
(entmake (list (cons 0 "LINE")(cons 10 np)(cons 11 p1)))
(entmake (list (cons 0 "LINE")(cons 10 p1)(cons 11 p2)))
(setq np p2
od (nth 1 p)))
(initget "Yes No")
(if (= "Yes" (getkword "\nSave This List As A Default (Y/N): "))
(setq sl_default sl))
(prin1))
sl_默认为global have fun-大卫 伙计，我需要学会怎么做！
谢谢你，大卫，我会喜欢这一个。。。
不客气！
我更新了代码。它不允许编辑/删除不同的段号-大卫 我不得不添加一个3D选项。只有我一个人
(defun c:ssel2 (/ sp d l n sc i sl od np xp p1 p2 tmp input)
;;;REMOVE AN EXPRESSION / ATOM FROM A LIST
(defun remove (expr lst);;;TonyT or VNesterowski
(apply 'append (subst nil (list expr) (mapcar 'list lst))))
(initget 1)
(setq sp (getpoint "\nStart Point: "))
(if sl_default
(setq sl sl_default
i (length sl))
(setq i 0))
(while (/= input "Finish")
(textpage)
(setq n nil)
(princ "\nSegment\tDiameter\tLength")
(foreach s sl
(princ (strcat "\n" (itoa (nth 0 s)) "\t" (rtos (nth 1 s) 2 4) "\t\t" (rtos (nth 2 s) 2 4))))
(if (= i 0)
(setq input "Add")
(progn
(initget 1 "Add Edit Remove Display Finish")
(setq input (getkword "\nAdd/Edit/Remove/Display/Finish:"))))
(cond ((= input "Add")
(setq i (1+ i))
(initget 7)
(setq d (getdist "\nAdd Segment Diameter: "))
(initget 7)
(setq l (getdist "\nAdd Segment Length: "))
(setq sl (cons (list i d l) (reverse sl)))
(setq sl (reverse sl)))
((= input "Remove")
(while (or (not n)
(not (assoc n sl)))
(setq n (getint "\nSegment Number To Remove: ")))
(setq sl (remove (assoc n sl) sl))
(setq tmp nil sc 0)
(foreach p sl
(setq tmp (cons (list (setq sc (1+ sc)) (nth 1 p) (nth 2 p)) tmp)))
(setq sl (reverse tmp)
i sc))
((= input "Edit")
(while (or (not n)
(not (assoc n sl)))
(setq n (getint "\nSegment Number To Edit: ")))
(princ "\n") (prin1 (assoc n sl))
(initget 7)
(setq d (getdist "\nNew Segment Diameter: "))
(initget 7)
(setq l (getdist "\nNew Segment Length: "))
(setq sl (subst (list n d l) (assoc n sl) sl)))
((= input "Display")
(graphscr)
(setq od 0)
(setq np sp)
(foreach p sl
(setq p1 (polar np (* pi 0.5) (* (- (nth 1 p) od) 0.5))
p2 (polar p1 (* pi 1.0) (nth 2 p)))
(grdraw np p1 2 3)
(grdraw p1 p2 2 3)
(setq np p2
od (nth 1 p)))
(getstring "\nPress Enter to Continue...."))))
;;;DRAW THE FINAL LINES
(graphscr)
(redraw)
(setq od 0
np sp)
(foreach p sl
(setq p1 (polar np (* pi 0.5) (* (- (nth 1 p) od) 0.5))
p2 (polar p1 (* pi 1.0) (nth 2 p)))
(entmake (list (cons 0 "LINE")(cons 10 np)(cons 11 p1)))
(entmake (list (cons 0 "LINE")(cons 10 p1)(cons 11 p2)))
(setq np p2
od (nth 1 p)))
;;;MAKE 3D SHAFT
(initget "Yes No")
(if (= "Yes" (getkword "\nDraw 3D Entities (Y/N) <No>: "))
(progn
(setq xp (car sp))
(foreach p sl
(entmake (list (cons 0 "CIRCLE")
(cons 10 (list (cadr sp) (caddr sp) xp))
(cons 39 (- (nth 2 p)))
(cons 40 (* (nth 1 p) 0.5))
(cons 210 (list 1 0 0))))
(setq xp (- xp (nth 2 p))))))
;;;TRY TO SAVE THE LIST
(initget 1 "Yes No")
(if (= "Yes" (getkword "\nSave This List As A Default (Y/N): "))
(setq sl_default sl)
(setq sl_default nil))
(prin1))
-大卫
哈哈！太棒了！
页:
1
[2]