帮助改进顺序n
我有一个很好的lisp，它可以对现有文本或具有属性的块按顺序编号/字母。我不太精通Lisp程序。我想知道是否有人可以修改这个lisp来处理带有文本的多重引线，更重要的是，使用包含属性的块的多重引线。或者可能已经有一个Lisp程序的存在？提前谢谢，
（我不知道这个Lisp程序是从哪里来的，也不知道是谁写的）。
以下是lisp代码：
;SEQ.LSP Sequential text
;;Automatic Sequential Numbering and Lettering
(defun *ERROR*(MSG)
(princ MSG)
(princ "\nFunction cancelled")
(princ)
)
(defun SQN()
(princ "\n")
(princ SEQ)
(setq ENT (entget (car (nentsel "\n - Select Text to Number"))))
(while ENT
(if (or (= (cdr (assoc 0 ENT)) "TEXT")
(= (cdr (assoc 0 ENT)) "ATTRIB"))
(progn
(entmod
(subst (cons 1 SEQ) (assoc 1 ENT) ENT)
)
(entupd (cdr (car ENT)))
(setq SEQ (itoa (1+ (read SEQ))))
)
(princ "\nEntity Must be TEXT")
)
(princ "\n")
(princ SEQ)
(setq ENT (entget (car (nentsel " - Select Text: "))))
(setq *SEQ (itoa (1+ (read SEQ))))
)
)
(defun SQL()
(princ "\n")
(princ SEQ)
(setq ENT (entget (car (nentsel "\nSelect Text to Letter"))))
(while ENT
(if (or (= (cdr (assoc 0 ENT)) "TEXT")
(= (cdr (assoc 0 ENT)) "ATTRIB"))
(progn
(entmod
(subst (cons 1 SEQ) (assoc 1 ENT) ENT)
)
(entupd (cdr (car ENT)))
(setq SEQ (chr (1+ (ascii SEQ))))
)
(princ "\nEntity Must be TEXT")
)
(princ "\n")
(princ SEQ)
(setq ENT (entget (car (nentsel " - Select Text: "))))
(setq *SEQ (chr (1+ (ascii SEQ))))
)
)
(defun C:SEQ(/ SEQ ENT)
(if (not *SEQ)
(setq *SEQ "1")
)
(princ (strcat "\nStarting Letter or Number <" *SEQ "> :"))
(setq SEQ (getstring))
(if (not (read SEQ))
(setq SEQ *SEQ)
(setq *SEQ SEQ)
)
(setq NUM (numberp (read SEQ)))
(setvar "cmdecho" 0)
(graphscr)
(if (not NUM)
(SQL)
(SQN)
)
(setvar "cmdecho" 1)
(princ)
) 这可能有助于它处理数字或alpha 1 A，版本2将检查最后一个数字/apha
; bubble pt num
; BY ALAN H AUG 2014
(alert "Type Bub to repeat")
(defun C:bub ( / ptnum ptnumb pt pt2 oldsnap chrnum)
(setq oldsnap (getvar "osmode"))
(setvar "textstyle" "standard")
(setq ptnum (getstring "\nEnter Pt Number or alpha"))
(setq chrnum (ascii (substr ptnum 1 1))) ; 1st character is number
(if (< chrnum 58)
(setq ptnumb (atof ptnum)) ;convert back to a number
)
(while (setq pt (getpoint "\Pick end of line Enter to exit"))
(setq pt2 (polar pt (/ pi 2.0) 3.0))
(setvar "osmode" 0)
(Command "circle" pt 3.0)
(command "move" "L" "" pt pt2)
(if (< chrnum 58)
(progn
(command "-Text" "J" "MC" pt "3.0" "" (rtos ptnumb 2 0))
(setq ptnumb (+ ptnumb 1))
)
(progn
(command "-Text" "J" "MC" pt "3.0" "" (chr chrnum))
(setq chrnum (+ chrnum 1))
)
)
(command "move" "L" "" pt pt2)
(setvar "osmode" 1)
)
(setvar "osmode" oldsnap)
(princ)
) ; end defun
(C:BUB)
(princ)
请阅读代码发布指南并编辑您的帖子，将代码包含在代码标签中。
页:
[1]