帮助改进顺序n

pioptl · 发表于 2022-7-5 22:17:37

我有一个很好的lisp，它可以对现有文本或具有属性的块按顺序编号/字母。我不太精通Lisp程序。我想知道是否有人可以修改这个lisp来处理带有文本的多重引线，更重要的是，使用包含属性的块的多重引线。或者可能已经有一个Lisp程序的存在？

提前谢谢，
（我不知道这个Lisp程序是从哪里来的，也不知道是谁写的）。
以下是lisp代码：

copy

;  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)
 )

BIGAL · 发表于 2022-7-5 23:04:05

这可能有助于它处理数字或alpha 1 A，版本2将检查最后一个数字/apha

copy


; 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)

SLW210 · 发表于 2022-7-5 23:28:26

请阅读代码发布指南并编辑您的帖子，将代码包含在代码标签中。

[编程交流] 帮助改进顺序n

发表回复

精选推荐