Re: Помогите переделать программу автоматической нумерации
> skkkk
Так должно работать
(defun c:numm2 (/ oldPref oldSuf oldStart curStr newNum
actDoc actSp oldEcho oldSize *error*)
(defun *error* (msg)
(setvar "CMDECHO" oldEcho)
(princ)
); end *error*
(vl-load-com)
(if(not num:Size)(setq num:Size(getvar "DIMTXT")))
(if(not num:Pref)(setq num:Pref ""))
(if(not num:Suf)(setq num:Suf ""))
(if(not num:Num)(setq num:Num 1))
(setq oldPref num:Pref
oldSuf num:Suf
oldStart num:Num
oldSize num:Size
actDoc(vla-get-ActiveDocument
(vlax-get-acad-object))
oldEcho(getvar "CMDECHO")
); end setq
(setvar "CMDECHO" 0)
(if(= (vla-get-ActiveSpace actDoc) 1)
(setq actSp(vla-get-ModelSpace actDoc))
(setq actSp(vla-get-PaperSpace actDoc))
); end setq
(setq num:Size
(getreal
(strcat "\nSpecify text size <"(rtos num:Size)">: ")))
(if(null num:Size)(setq num:Size oldSize))
(setq num:Pref
(getstring T
(strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"num:Pref"> :")))
(if(= "" num:Pref)(setq num:Pref oldPref))
(if(= " " num:Pref)(setq num:Pref ""))
(setq num:Suf
(getstring T
(strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"num:Suf"> :")))
(if(= "" num:Suf)(setq num:Suf oldSuf))
(if(= " " num:Suf)(setq num:Suf ""))
;;;=============================================================================
;;; Степень \A1;12{\H0.7x;\S23^;} ;_=
(if (/= num:Suf "")(setq num:Suf (strcat "{\\A1;\\H0.7x;\\S" num:Suf "^;}")));_=
;;;=============================================================================
(setq num:Num
(getint
(strcat "\nEnter start number <"(itoa num:Num)">: ")))
(if(null num:Num)(setq num:Num oldStart))
(while T
(setq curStr(strcat num:Pref(itoa num:Num)num:Suf)
newNum(vla-AddMText actSp
(vlax-3d-point '(0.0 0.0 0.0)) 0 curStr))
(vla-put-height newNum num:Size)
(vla-put-AttachmentPoint newNum acAttachmentPointMiddleCenter)
(vla-put-InsertionPoint newNum (vlax-3d-point '(0.0 0.0 0.0)))
(command "_.copybase"(trans '(0.0 0.0 0.0)0 1)(entlast)"")
(command "_.erase" (entlast) "")
(command "_.pasteclip" pause)
(setq num:Num(1+ num:Num))
); end while
(princ)
)
