请帮忙解决一下不能运行的问题,谢谢各位

linheyuanpcb

(defun c:TSK001 () (defun c:TSK001 ()
(prompt "\n **<日期:2007-07-14.TSK001>**") (prompt "\n **<日期:2007-07-14.TSK001>**")
(prompt "\n **<用途:圖塊中心點連線>**") (prompt "\n **<用途:图块中心点连线>**")
(command "undo" "be") (command "undo" "be")
;;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
(PRINT "選取連線圖塊...") (PRINT "选取连线图块...")
(SETQ S1 (SSGET (LIST (CONS 2 "12")) )) ;;圖塊名稱請自行命名設定 (SETQ S1 (SSGET (LIST (CONS 2 "12")) )) ;;图块名称请自行命名设定
(SETQ I 0) (SETQ I 0)
(setq PT_S1 nil) (setq PT_S1 nil)
(REPEAT (SSLENGTH S1) (REPEAT (SSLENGTH S1)
(SETQ EN (SSNAME S1 I)) (SETQ EN (SSNAME S1 I))
(SETQ VLA_EN (vlax-ename->vla-object EN)) (SETQ VLA_EN (vlax-ename->vla-object EN))
(SETQ PT_S1 (append PT_S1 (LIST (vlax-get VLA_EN 'insertionpoint) ))) (SETQ PT_S1 (append PT_S1 (LIST (vlax-get VLA_EN 'insertionpoint) )))
(SETQ I (1+ I)) (SETQ I (1+ I))
)
;;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
(PRINT "選取連線基準圖塊...") (PRINT "选取连线基准图块...")
(SETQ S2 (SSGET (LIST (CONS 2 "12")) )) ;;圖塊名稱請自行命名設定 (SETQ S2 (SSGET (LIST (CONS 2 "12")) )) ;;图块名称请自行命名设定
(SETQ I 0) (SETQ I 0)
(setq PT_S2 nil) (setq PT_S2 nil)
(REPEAT (SSLENGTH S2) (REPEAT (SSLENGTH S2)
(SETQ EN (SSNAME S2 I)) (SETQ EN (SSNAME S2 I))
(SETQ VLA_EN (vlax-ename->vla-object EN)) (SETQ VLA_EN (vlax-ename->vla-object EN))
(SETQ PT_S2 (append PT_S2 (LIST (vlax-get VLA_EN 'insertionpoint) ))) (SETQ PT_S2 (append PT_S2 (LIST (vlax-get VLA_EN 'insertionpoint) )))
(SETQ I (1+ I)) (SETQ I (1+ I))
)

(princ "\n 提示排序方式: E配A , C配B ...") (princ "\n提示排序方式: E配A , C配B ...")
(SETQ PT_S1 (SORT_TYPE8_PT_LIST PT_S1)) ;E配A (SETQ PT_S1 (SORT_TYPE8_PT_LIST PT_S1)) ;E配A
(SETQ PT_S2 (SORT_TYPE8_PT_LIST PT_S2)) (SETQ PT_S2 (SORT_TYPE8_PT_LIST PT_S2))
(SETQ E 0) (SETQ E 0)
(REPEAT (1- (length PT_S2)) (REPEAT (1- (length PT_S2))
(SETQ PT_S2-X (NTH E PT_S2) (SETQ PT_S2-X (NTH E PT_S2)
PT_S2-Y (NTH (1+ E) PT_S2) PT_S2-Y (NTH (1+ E) PT_S2)
) ;_ 結束SETQ ) ;_结束SETQ
(COMMAND "_LINE" PT_S2-X PT_S2-Y "") (COMMAND "_LINE" PT_S2-X PT_S2-Y "")
(SETQ E (1+ E)) (SETQ E (1+ E))
)
(SETQ I 0) (SETQ I 0)
(REPEAT (LENGTH PT_S2) (REPEAT (LENGTH PT_S2)
(SETQ PT_XT (NTH I PT_S2)) (SETQ PT_XT (NTH I PT_S2))
(SETQ PT_X PT_XT) (SETQ PT_X PT_XT)
(IF (EQUAL PT_XT (LAST PT_S2)) (IF (EQUAL PT_XT (LAST PT_S2))
(SETQ PT_XL (LAST PT_S2)) (SETQ PT_XL (LAST PT_S2))
(SETQ PT_XL (NTH (1+ I) PT_S2)) (SETQ PT_XL (NTH (1+ I) PT_S2))
)
(SETQ E 0) (SETQ E 0)
(SETQ Q 0) ;while關鍵 (SETQ Q 0) ;while关键
(WHILE Q (WHILE Q
(SETQ PT_Y (CAR PT_S1)) (SETQ PT_Y (CAR PT_S1))
(COND
((= PT_S1 NIL) ;;判斷串列是否為空 ((= PT_S1 NIL) ;;判断串列是否为空
(SETQ Q NIL) (SETQ Q NIL)
)
((EQUAL PT_XT PT_Y) ;;判斷座標是否相同 ((EQUAL PT_XT PT_Y) ;;判断座标是否相同
(SETQ Q 0) (SETQ Q 0)
(SETQ PT_S1 (cdr PT_S1)) (SETQ PT_S1 (cdr PT_S1))
)

((EQUAL PT_XL PT_Y) ((EQUAL PT_XL PT_Y)
(SETQ PT_S1 (cdr PT_S1)) (SETQ PT_S1 (cdr PT_S1))
(SETQ Q NIL) (SETQ Q NIL)
)
(T
(COMMAND "_LINE" PT_X PT_Y "") (COMMAND "_LINE" PT_X PT_Y "")
(SETQ PT_X PT_Y) (SETQ PT_X PT_Y)
(SETQ Q 0) (SETQ Q 0)
(SETQ PT_S1 (cdr PT_S1)) (SETQ PT_S1 (cdr PT_S1))
)
)
)
(SETQ I (1+ I)) (SETQ I (1+ I))
)
;;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
(command "undo" "e") (command "undo" "e")
(prin1))
;;階層排序 ;;阶层排序
(defun sort-x-min-li (lst) (defun sort-x-min-li (lst)
(vl-sort lst '(lambda (xy) (< (car x)(car y) ) )) (vl-sort lst '(lambda (xy) (< (car x)(car y) ) ))
) ;X左->右 ) ;X左->右
(defun sort-x-max-li (lst) (defun sort-x-max-li (lst)
(vl-sort lst '(lambda (xy) (> (car x)(car y) ) )) (vl-sort lst '(lambda (xy) (> (car x)(car y) ) ))
) ;X右->左 ) ;X右->左
(defun sort-y-min-li (lst) (defun sort-y-min-li (lst)
(vl-sort lst '(lambda (xy) (< (cadr x)(cadr y) ) )) (vl-sort lst '(lambda (xy) (< (cadr x)(cadr y) ) ))
) ;Y下->上 ) ;Y下->上
(defun sort-y-max-li (lst) (defun sort-y-max-li (lst)
(vl-sort lst '(lambda (xy) (> (cadr x)(cadr y) ) )) (vl-sort lst '(lambda (xy) (> (cadr x)(cadr y) ) ))
) ;Y上->下 ) ;Y上->下
;;處理排序程式 ;;处理排序程式
(DEFUN SORT_TYPE8_PT_LIST ( lst / ) (DEFUN SORT_TYPE8_PT_LIST ( lst / )
(princ "\n 排序方式:") (princ "\n排序方式:")
(princ "\n <Y方向>") (princ "\n <Y方向>")
(princ "\n (A)左->右&上->下_(B)左->右&下->上_(C)右->左&上->下_(D)右->左&下->上") (princ "\n (A)左->右&上->下_(B)左->右&下->上_(C)右->左&上->下_(D)右->左&下->上")
(princ "\n <X方向>") (princ "\n <X方向>")
(princ "\n (E)上->下&左->右_(F)上->下&右->左_(G)下->上&左->右_(H)下->上&右->左") (princ "\n (E)上->下&左->右_(F)上->下&右->左_(G)下->上&左->右_(H)下->上&右->左")
(princ ".....<<")(princ "預設為A") (princ ">>:") (princ ".....<<")(princ "预设为A") (princ ">>:")
(initget "abcdefgh") (initget "abcdefgh")
(setq sf1 (getkword)) (setq sf1 (getkword))
(if (= sf1 nil)(setq sf1 A)) (if (= sf1 nil)(setq sf1 A))
(cond
((= sf1 "a")(progn ((= sf1 "a")(progn
(setq lstnew (sort-y-max-li lst)) (setq lstnew (sort-y-max-li lst))
(setq lstnew2 (sort-x-min-li lstnew)) (setq lstnew2 (sort-x-min-li lstnew))
)) ;;_(A)左->右&上->下 )) ;;_(A)左->右&上->下
((= sf1 "b")(progn ((= sf1 "b")(progn
(setq lstnew (sort-y-min-li lst)) (setq lstnew (sort-y-min-li lst))
(setq lstnew2 (sort-x-min-li lstnew)) (setq lstnew2 (sort-x-min-li lstnew))
)) ;;_(B)左->右&下->上 )) ;;_(B)左->右&下->上
((= sf1 "c")(progn ((= sf1 "c")(progn
(setq lstnew (sort-y-max-li lst)) (setq lstnew (sort-y-max-li lst))
(setq lstnew2 (sort-x-max-li lstnew)) (setq lstnew2 (sort-x-max-li lstnew))
)) ;;_(C)右->左&上->下 )) ;;_(C)右->左&上->下
((= sf1 "d")(progn ((= sf1 "d")(progn
(setq lstnew (sort-y-min-li lst)) (setq lstnew (sort-y-min-li lst))
(setq lstnew2 (sort-x-max-li lstnew)) (setq lstnew2 (sort-x-max-li lstnew))
)) ;;_(D)右->左&下->上 )) ;;_(D)右->左&下->上
((= sf1 "e")(progn ((= sf1 "e")(progn
(setq lstnew (sort-x-min-li lst)) (setq lstnew (sort-x-min-li lst))
(setq lstnew2 (sort-y-max-li lstnew)) (setq lstnew2 (sort-y-max-li lstnew))
)) ;;_(E)上->下&左->右 )) ;;_(E)上->下&左->右
((= sf1 "f")(progn ((= sf1 "f")(progn
(setq lstnew (sort-x-max-li lst)) (setq lstnew (sort-x-max-li lst))
(setq lstnew2 (sort-y-max-li lstnew)) (setq lstnew2 (sort-y-max-li lstnew))
)) ;;_(F)上->下&右->左 )) ;;_(F)上->下&右->左
((= sf1 "g")(progn ((= sf1 "g")(progn
(setq lstnew (sort-x-min-li lst)) (setq lstnew (sort-x-min-li lst))
(setq lstnew2 (sort-y-min-li lstnew)) (setq lstnew2 (sort-y-min-li lstnew))
)) ;;_(G)下->上&左->右 )) ;;_(G)下->上&左->右
((= sf1 "h")(progn ((= sf1 "h")(progn
(setq lstnew (sort-x-max-li lst)) (setq lstnew (sort-x-max-li lst))
(setq lstnew2 (sort-y-min-li lstnew)) (setq lstnew2 (sort-y-min-li lstnew))
)) ;;_(H)下->上&右->左 )) ;;_(H)下->上&右->左
)
lstnew2
)
(prompt "\n **<問題:沒有解決圖塊框線切割問題...>**") (prompt "\n **<问题:没有解决图块框线切割问题...>**")
(prompt "\n **<命令:TSK001>**") (prompt "\n **<命令:TSK001>**")