;; (vl-load-com) ;;(arx) (defun &GetEntDxf (ent_name code / ent vla_name result) (if (and ent_name code) (progn (setq result nil) (setq vla_name (vlax-ename->vla-object ent_name)) (cond ((= code 62) (setq result (vlax-get-property vla_name 'color)) ) ((= code 6) (setq result (vlax-get-property vla_name 'linetype)) ) ((= code 48) (setq result (vlax-get-property vla_name 'linetypescale)) ) (T (progn (setq ent (entget ent_name)) (setq result (cdr (assoc code ent))) ) ) ) ) nil ) result ) ;; (defun &SortSs_X (ss /) (&SortSs ss 1) ) (defun &SortSs_X2 (ss /) (&SortSs ss 2) ) (defun &SortSs_Y (ss /) (&SortSs ss 3) ) (defun &SortSs_Y2 (ss /) (&SortSs ss 4) ) (defun &SortSs (ss ii / i ii pts ss ss1 index) (setq ss ss) (setq ii ii) (if (and ss (> (sslength ss) 1) ) (progn (setq i 0) (setq pts nil) (repeat (sslength ss) (setq pts (cons (&GetEntDxf (ssname ss i) 10) pts)) (setq i (+ i 1)) ) (setq pts (reverse pts) ss1 (ssadd) ) (cond ((= ii 1) (setq index (&SortX_Index pts))) ((= ii 2) (setq index (&SortX2_Index pts))) ((= ii 3) (setq index (&SortY_Index pts))) ((= ii 4) (setq index (&SortY2_Index pts))) ) (setq i 0) (repeat (sslength ss) (setq ss1 (ssadd (ssname ss (nth i index)) ss1)) (setq i (+ i 1)) ) (setq i 0) (setq pts nil) (repeat (sslength ss1) (setq pts (cons (&GetEntDxf (ssname ss1 i) 10) pts)) (setq i (+ i 1)) ) ) ) (list ss1 (reverse pts)) ) ;; ;;;(&SortX_Index '((1 3) (2 5) (3 1)(4 6))) (defun &SortX_Index (lst / lst e1 e2) (setq lst lst) (setq lst (vl-sort-i lst (function (lambda (e1 e2) (< (car e1) (car e2)) ) ) ) ) ) ;;;(&SortX2_Index '((1 3) (2 5) (3 1)(4 6))) (defun &SortX2_Index (lst / lst e1 e2) (setq lst lst) (setq lst (vl-sort-i lst (function (lambda (e1 e2) (> (car e1) (car e2)) ) ) ) ) ) ;;;(&SortY_Index '((1 4) (1 2) (1 3)(1 1))) (defun &SortY_Index (lst / lst e1 e2) (setq lst lst) (setq lst (vl-sort-i lst (function (lambda (e1 e2) (< (cadr e1) (cadr e2)) ) ) ) ) ) ;;;(&SortY2_Index '((1 4) (1 2) (1 3)(1 1))) (defun &SortY2_Index (lst / lst e1 e2) (setq lst lst) (setq lst (vl-sort-i lst (function (lambda (e1 e2) (> (cadr e1) (cadr e2)) ) ) ) ) ) ;; (defun &SsNameList (ss / n lst) (if (= 'PICKSET (type ss)) (repeat (setq n (sslength ss)) (setq n (1- n) lst (cons (ssname ss n) lst) ) ) ) ) ;; (defun &EntMod (ent_name dxf_lst / i ent num input1 input2 color linetype) (if (and ent_name (setq ent (entget ent_name)) (> (setq num (/ (length dxf_lst) 2)) 0) ) (progn (setq i 0) (repeat num (setq input1 (nth (* i 2) dxf_lst)) (setq input2 (nth (+ (* i 2) 1) dxf_lst)) (cond ((= input1 62) (vlax-put-property (vlax-ename->vla-object ent_name) 'color input2 ) ) ((= input1 6) (vlax-put-property (vlax-ename->vla-object ent_name) 'linetype input2 ) ) ((= input1 48) (vlax-put-property (vlax-ename->vla-object ent_name) 'linetypescale input2 ) ) ((and (/= input1 62) (/= input1 6) (/= input1 48)) (progn (setq ent (subst (cons input1 input2) (assoc input1 ent) ent) ) (setq ent (entmod ent)) ) ) ) (setq i (+ i 1)) ) (cdr (assoc -1 ent)) ) nil ) ) ;; (defun &Begin (SysVarLst / x y) (Defun *Error* (St) (If (/= St "函数已取消") (Princ "\n**函数已取消**") ) (&End) (Princ) ) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)) ) (if (/= (length SysVarLst) 0) (setq *OriSysVars* (mapcar '(lambda (x / y) (if (= (type x) 'LIST) (setq y (list (car x) (getvar (car x)))) (setq y (list x (getvar x))) ) (if (/= (type x) 'STR) (eval (cons 'setvar x)) ) y ) SysVarLst ) ) ) (setq &error *error* *error* &error ) (princ) ) (Defun &End () (If *Orisysvars* (Mapcar '(Lambda (X) (Eval (Cons 'Setvar X)) ) *Orisysvars* ) ) (Vla-Endundomark (Vla-Get-Activedocument (Vlax-Get-Acad-Object)) ) (Setq *Error* &Error) (Setq *Orisysvars* Nil &Error Nil ) (Princ) ) ;; (defun &ListTable (s / d r) (while (setq d (tblnext s (null d))) (setq r (cons (cdr (assoc 2 d)) r)) ) (vl-remove 'nil (acad_strlsort (reverse r))) ) ;; (defun & utVarible (Varible Varible_Save Val_default) (if (null Varible_Save) (setq Varible Val_default) (setq Varible Varible_Save) ) ) ;; (defun &TileEnable (clist) (mapcar '(lambda (x) (mode_tile x 0) ) clist ) ) ;;禁用按钮 ;;clist 按钮关键字列表 (defun &TileDisable (clist) (mapcar '(lambda (x) (mode_tile x 1) ) clist ) ) ;; ;|; (If (Member "acetutil.arx" (Arx)) (setq Acetutil_loaded T) (If (Findfile "Acetutil.Arx") (if (Arxload "Acetutil.Arx") (setq Acetutil_loaded T) (setq Acetutil_loaded nil) ) (setq Acetutil_loaded nil) ) );|; ;; (defun c:123 (/ Dcl_Id Do_What List_Sort Style_Cur List_Style Index_Style Edit_Type Prefix Start_Num Suffix Inc_Num Index_Sort Judge_Replace Pt_Screen Txt_Height Sort_Type ) (Defun Edit_Write (/ Ss I Ss_List N Txt_Ori Txt_Num Txt_New Pt1 Pt Ent_Txt) ;;编辑模式 (If (= Edit_Type 1) (Progn (If (And (Setq Ss (Ssget '((0 . "TEXT")))) (Setq I -1) ) (Progn (Cond ((= Index_Sort "0") (Setq Ss (Car (&SortSs_Y2 Ss)))) ((= Index_Sort "2") (Setq Ss (Car (&SortSs_X Ss)))) ((= Index_Sort "1") (Setq Ss (Car (&SortSs_Y Ss)))) ((= Index_Sort "3") (Setq Ss (Car (&SortSs_X2 Ss)))) ) (Setq Ss_List (&SsNameList Ss)) (Foreach N Ss_List (Progn (Setq Txt_Ori (&GetEntDxf N 1) Txt_Num (Itoa (+ (Atoi Start_Num) (* (Setq I (1+ I)) (Atoi Inc_Num)) ) ) ) (If (= Start_Num "") (Setq Txt_Num "") ) (Cond ((= Judge_Replace "0") (Setq Txt_New (Strcat Prefix Txt_Num Txt_Ori Suffix)) ) ((= Judge_Replace "1") (Setq Txt_New (Strcat Prefix Txt_Num Suffix)) ) ) (&EntMod N (List 1 Txt_New)) ) ) (redraw) ) ) ) ) ;;书写模式 (If (= Edit_Type 2) (Progn (Setq I -1) (while (setq pt (getpoint "\n点取文字插入点[退出]")) (Setq Txt_Num (Itoa (+ (Atoi Start_Num) (* (Setq I (1+ I)) (Atoi Inc_Num)) ) ) ) (If (= Start_Num "") (Setq Txt_Num "") ) (Setq Txt_New (Strcat Prefix Txt_Num Suffix)) (Vl-Cmdf "Text" "S" Txt_Style pt Txt_Height 0 Txt_New) ) ;|;(if Acetutil_loaded (progn (Setq Pt1 (Car (&GetScreenPts))) (Setq I -1) (While (And (Progn (Setq Txt_Num (Itoa (+ (Atoi Start_Num) (* (Setq I (1+ I)) (Atoi Inc_Num)) ) ) ) (If (= Start_Num "") (Setq Txt_Num "") ) (Setq Txt_New (Strcat Prefix Txt_Num Suffix)) ) (Progn (Vl-Cmdf "Text" "S" Txt_Style Pt1 Txt_Height 0 Txt_New) (Setq Ent_Txt (Entlast) Ss (Ssadd) Ss (Ssadd Ent_Txt Ss) ) (&Redraw_Ss Ss 2) ) (Setq Pt (Acet-Ss-Drag-Move Ss Pt1 "\n插入位置:")) ) (Command ".Move" Ss "" Pt1 Pt) ) (If (And SS (Null Pt)) (&Erase_Ss Ss) ) );|; ) ) ) ;;Main (&Begin '(("Cmdecho" 0)("Orthomode" 0))) (Setq Dcl_Id (Load_Dialog "AutoNum.Dcl")) (Setq Do_What 2) (Setq List_Sort '("上 => 下" "上 <= 下" "左 => 右" "左 <= 右")) (Setq Style_Cur (Getvar "TEXTSTYLE") List_Style (&ListTable "STYLE") Index_Style (Itoa (Vl-Position Style_Cur List_Style)) Txt_Style (Nth (Atoi Index_Style) List_Style) ) (Setq Edit_Type (& utVarible Edit_Type AutoNum_Edit_Type_Save 1) Prefix (& utVarible Prefix AutoNum_Prefix_Save "No.") Start_Num (& utVarible Start_Num AutoNum_Start_Num_Save "1") Suffix (& utVarible Suffix AutoNum_Suffix_Save "") Inc_Num (& utVarible Inc_Num AutoNum_Inc_Num_Save "1") Index_Sort (& utVarible Index_Sort AutoNum_Index_Sort_Save "0") Judge_Replace (& utVarible Judge_Replace AutoNum_Judge_Replace_Save "0" ) Pt_Screen (& utvarible Pt_Screen AutoNum_Pt_Screen_Save (List 500 600) ) Txt_Height (& utVarible Txt_Height AutoNum_Txt_Height_Save (Rtos (Getvar "TEXTSIZE") 2 2) ) ) ;;(Setq Prefix "No.") (Setq Sort_Type (Nth (Atoi Index_Sort) List_Sort)) (Vl-Cmdf "Undo" "Be") (While (= Do_What 2) (Progn (If (Not (New_Dialog "AutoNum" Dcl_Id "" Pt_Screen)) (Exit) ) ;;初始化 (Start_List "Sort_Type") (Mapcar 'Add_List List_Sort) (End_List) (Start_List "Style") (Mapcar 'Add_List List_Style) (End_List) (Set_Tile "Prefix" Prefix) (Set_Tile "Start_No" Start_Num) (Set_Tile "Suffix" Suffix) (Set_Tile "Inc" Inc_Num) (Set_Tile "Sort_Type" Index_Sort) (Set_Tile "Replace" Judge_Replace) (Set_Tile "Height" Txt_Height) (Set_Tile "Style" Index_Style) (cond ((= Edit_Type 1) (Progn (Set_Tile "Edit_Mode" "1") (Set_Tile "Write_Mode" "0") ;;(Setq Prefix "No.") (Set_Tile "Prefix" Prefix) (&TileEnable '("Sort_Type" "Replace")) (&TileDisable '("Height" "Style")) ) ) ((= Edit_Type 2) (Progn (Set_Tile "Edit_Mode" "0") (Set_Tile "Write_Mode" "1") ;;(Setq Prefix "KL-") (Set_Tile "Prefix" Prefix) (&TileEnable '("Height" "Style")) (&TileDisable '("Sort_Type" "Replace")) ) ) ) ;;定义动作 (Action_Tile "Prefix" "(Setq Prefix $Value)") (Action_Tile "Start_No" "(Setq Start_Num $Value)") (Action_Tile "Suffix" "(Setq Suffix $Value)") (Action_Tile "Inc" "(Setq Inc_Num $Value)") (Action_Tile "Sort_Type" "(Setq Index_Sort $Value) (Setq Sort_Type (Nth (Atoi Index_Sort) List_Sort))" ) (Action_Tile "Replace" "(Setq Judge_Replace $Value)") (Action_Tile "Edit_Mode" "(Setq Edit_Type 1) (Set_Tile \"Prefix\" Prefix) (Set_Tile \"Edit_Mode\" \"1\") (Set_Tile \"Write_Mode\" \"0\") (&TileDisable '(\"Sort_Type\" \"Replace\")) (&TileEnable '(\"Height\" \"Style\"))" ) (Action_Tile "Write_Mode" "(Setq Edit_Type 2) (Set_Tile \"Prefix\" Prefix) (Set_Tile \"Edit_Mode\" \"0\") (Set_Tile \"Write_Mode\" \"1\") (&TileDisable '(\"Sort_Type\" \"Replace\")) (&TileEnable '(\"Height\" \"Style\"))" ) (Action_Tile "Height" "(Setq Txt_Height $Value)") (Action_Tile "Style" "(Setq Index_Style $Value) (Setq Txt_Style (Nth (Atoi Index_Style) List_Style))" ) (Action_Tile "accept" "(Setq Pt_Screen (Done_Dialog 2))") (Action_Tile "cancel" "(Done_Dialog 0)") (Setq Do_What (Start_Dialog)) (If (= Do_What 2) (Edit_Write) ) ) ) (Unload_Dialog Dcl_Id) (Vl-Cmdf "Undo" "E") (Setq AutoNum_Edit_Type_Save Edit_Type AutoNum_Prefix_Save Prefix AutoNum_Start_Num_Save Start_Num AutoNum_Suffix_Save Suffix AutoNum_Inc_Num_Save Inc_Num AutoNum_Index_Sort_Save Index_Sort AutoNum_Judge_Replace_Save Judge_Replace AutoNum_Pt_Screen_Save Pt_Screen AutoNum_Txt_Height_Save Txt_Height ) (&End) (Princ) )
|