明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1172|回复: 2

请斑竹帮忙看下下面的代码那里出问题了!

[复制链接]
发表于 2009-5-24 11:35:00 | 显示全部楼层 |阅读模式

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

 楼主| 发表于 2009-5-24 11:36:00 | 显示全部楼层

一运行就出现:"函数已取消"!

纳闷了!

发表于 2009-5-24 15:04:00 | 显示全部楼层
对话框哪去了?
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-9-29 18:29 , Processed in 0.153325 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表