;;;此行显示函数参数个数不正确，代码中已经注明，请问该怎么修改呀

yangchao2005090

;;;此行显示函数参数个数不正确，代码中已经注明，请问该怎么修改呀

2. ;;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=72665&extra=&highlight=%BD%C7&page=1
   
3. (defun c:yad_fillet(/ yad-dxf yad-entsel yad-movetotop yad-interpt goto_fillet oldpedit oldos acaddoc mspace trm p1 p2 prom lprom r boxlen ss l_bak l_pt ent i)
   
4.   (defun yad-dxf(en val) (cdr (assoc val (entget en))))
   
5.   (defun yad-entsel(msg filter / ext ent pt s)
   
6.     (while (not ext)
   
7.       (setq ent (entsel msg))
   
8.       (cond
   
9.         ((= (getvar "errno") 52) (setq ext T) (setvar "errno" 0) nil)
   
10.         ((and ent (setq s (ssget "_c" (polar (setq pt (cadr ent)) (* pi 1.25) boxlen) (polar pt (/ pi 4) boxlen) filter)) (setq ext T)) (list (ssname s 0) pt))
    
11.         (T (prompt "\n圆角需要直线、圆弧、圆或多段线！"))
    
12.       )
    
13.     )
    
14.   )
    
15.   (defun yad-movetotop(l_ent / extdic tbl)
    
16.     (setq l_ent (mapcar 'vlax-ename->vla-object l_ent))
    
17.     (setq extdic (vla-getextensiondictionary mspace))
    
18.     (if (vl-catch-all-error-p (setq tbl (vl-catch-all-apply 'vla-item (list extdic "acad_sortents"))))
    
19.       (setq tbl (vla-addobject extdic "acad_sortents" "acdbsortentstable"));;;此行显示函数参数个数不正确
    
20.     )
    
21.     (vlax-invoke tbl "MoveToTop" l_ent)
    
22.   )
    
23.   (defun yad-interpt(obj s / n ent ipt pt l_p)
    
24.     (setq obj (vlax-ename->vla-object obj) n -1)
    
25.     (repeat (sslength s)
    
26.       (setq ent (vlax-ename->vla-object (ssname s (setq n (1+ n)))) ipt (vlax-variant-value (vla-intersectwith obj ent 0)))
    
27.       (if (and (> (vlax-safearray-get-u-bound ipt 1) 0) (setq ipt (vlax-safearray->list ipt)))
    
28.         (while (> (length ipt) 0)
    
29.           (setq pt (list (car ipt) (cadr ipt) (caddr ipt)) ipt (cdddr ipt))
    
30.           (if (not (vl-member-if '(lambda(e) (equal e pt boxlen)) l_p)) (setq l_p (cons pt l_p)))
    
31.         )
    
32.       )
    
33.     )
    
34.     (vla-delete obj)
    
35.     l_p
    
36.   )
    
37.   (defun goto_fillet(p1 p2 / ent1 ent2 wid ent2ispl s oldent newent)
    
38.     (setq ent1 (car p1))
    
39.     (if (not p2) (redraw ent1 3))
    
40.     (if (or p2 (setq p2 (yad-entsel "\n选择第二个对象：" '((0 . "LINE,XLINE,RAY,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE")))))
    
41.       (if (and (setq ent2 (car p2)) (member "LWPOLYLINE" (mapcar '(lambda(e) (yad-dxf e 0)) (list ent1 ent2))))
    
42.         (progn
    
43.           (redraw ent1 4)
    
44.           (if (= (yad-dxf ent2 0) "LWPOLYLINE")
    
45.             (setq ent1 p2 p2 (cadr p1) ent2 (car p1) p1 (cadr ent1) ent1 (car ent1))
    
46.             (setq p1 (cadr p1) p2 (cadr p2))
    
47.           )
    
48.           (setq wid (yad-dxf ent1 40) ent2ispl (= (yad-dxf ent2 0) "LWPOLYLINE"))
    
49.           (if (= trm 0)
    
50.             (progn
    
51.               (vla-copy (vlax-ename->vla-object ent1))
    
52.               (if (and ent2ispl (not (equal ent1 ent2))) (vla-copy (vlax-ename->vla-object ent2)))
    
53.               (yad-movetotop (if (equal ent1 ent2) (list ent1) (list ent1 ent2)))
    
54.             )
    
55.             (vl-cmdf "_.undo" "_m")
    
56.           )
    
57.           (setvar "qaflags" 1)
    
58.           (if ent2ispl (vl-cmdf "_.explode" ent1 ent2 "") (vl-cmdf "_.explode" ent1 ""))
    
59.           (setq s (ssget "_p") oldent (entlast))
    
60.           (setvar "qaflags" 0)
    
61.           (vl-catch-all-apply 'vl-cmdf (list "_.fillet" (setq ent1 (nentselp p1)) (setq ent2 (nentselp p2))))
    
62.           (cond
    
63.             ((= trm 0))
    
64.             ((and (equal (setq newent (entlast)) oldent) (/= (getvar "filletrad") 0)) (vl-cmdf "_.undo" "_b"))
    
65.             (T (vl-catch-all-apply 'vl-cmdf (append (list "_.pedit" (car ent1) "_j")
    
66.                                               (if (equal newent oldent) nil (list newent))
    
67.                                               (if (= (yad-dxf (setq ent2 (car ent2)) 0) "CIRCLE") nil (list ent2))
    
68.                                               (list s "" "_w" wid "")))
    
69.             )
    
70.           )
    
71.           (vl-cmdf "_.erase" s "")
    
72.         )
    
73.         (vl-catch-all-apply 'vl-cmdf (list "_.fillet" p1 p2))
    
74.       )
    
75.       (redraw ent1 4)
    
76.     )
    
77.   )
    
78.   (vl-load-com)
    
79.   (setq oldpedit (getvar "peditaccept") oldos (getvar "osmode")
    
80.     mspace (vla-get-modelspace (setq acaddoc (vla-get-activedocument (vlax-get-acad-object))))
    
81.   )
    
82.   (setvar "peditaccept" 1)
    
83.   (setvar "osmode" 0)
    
84.   (setvar "cmdecho" 0)
    
85.   (setvar "errno" 0)
    
86.   (vl-cmdf "_.undo" "_c" "_n" "_.undo" "")
    
87.   (while (/= (getvar "errno") 52)
    
88.     (princ "\n当前设置：模式 = ")
    
89.     (princ (if (= (setq trm (getvar "trimmode")) 1) "修剪" "不修剪"))
    
90.     (princ "，半径 = ")
    
91.     (princ (getvar "filletrad"))
    
92.     (initget (if (= trm 1) "U N" "U T"))
    
93.     (setq p1 (entsel (strcat "\n" (setq prom (strcat "选择对象或指定圆角半径或[放弃(U)/" (if (= trm 1) "不修剪对象(N)" "修剪对象(T)")"]：")))))
    
94.     (princ "\n")
    
95.     (setq lprom (getvar "lastprompt") r (substr lprom (1+ (vl-string-mismatch prom lprom)))
    
96.       boxlen (abs (/ (* (/ (getvar "pickbox") (cadr (getvar "screensize"))) (getvar "viewsize")) (sin (/ pi 4))))
    
97.     )
    
98.     (if (numberp (setq r (read r)))
    
99.       (setvar "filletrad" (abs r))
    
100.       (cond
     
101.         ((= p1 "U") (vl-cmdf "_.u"))
     
102.         ((= p1 "T") (setvar "trimmode" 1))
     
103.         ((= p1 "N") (setvar "trimmode" 0))
     
104.         ((and (not p1) (/= (getvar "errno") 52) (setq p2 (getcorner (setq p1 (cadr (grread T 6 2))) "\n指定对角点：")))
     
105.           (vla-startundomark acaddoc)
     
106.           (setq ss nil l_bak nil l_pt nil)
     
107.           (cond
     
108.             ((and (setq ss (ssget "_f" (list p1 p2) '((0 . "LINE,XLINE,RAY,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
     
109.                (vla-addline mspace (vlax-3d-point p1) (vlax-3d-point p2))
     
110.                (setq l_bak (list ss (setq l_pt (yad-interpt (entlast) ss))))
     
111.                (> (sslength ss) 1) (> (length l_pt) 1)
     
112.              )
     
113.             )
     
114.             ((and (setq ss (ssget "_f" (list p1 (list (car p1) (cadr p2)) p2 (list (car p2) (cadr p1)) p1) '((0 . "LINE,XLINE,RAY,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
     
115.                (vl-cmdf "_.rectang" "_f" 0 p1 p2)
     
116.                (setq l_pt (yad-interpt (entlast) ss))
     
117.              )
     
118.             )
     
119.           )
     
120.           (if (and l_bak (or (< (length l_pt) 2) (and (= (sslength ss) 1) (> (length (cadr l_bak)) 1)))) (setq ss (car l_bak) l_pt (cadr l_bak)))
     
121.           (cond
     
122.             ((not ss)
     
123.               (princ "\n没有交叉框选到直线、圆弧、圆、椭圆、多段线或样条曲线！")
     
124.             )
     
125.             ((or (= (sslength ss) 1) (= (length l_pt) 1))
     
126.               (goto_fillet (list (setq ent (ssname ss 0)) (car l_pt)) (if (and (= (yad-dxf ent 0) "LWPOLYLINE") (> (length l_pt) 1)) (list ent (cadr l_pt)) nil))
     
127.             )
     
128.             (T
     
129.               ;(setq p1 (nentselp (car l_pt)) l_pt (cdr l_pt) i -1)
     
130.               ;(while (and (setq p2 (nth (setq i (1+ i)) l_pt)) (setq p2 (nentselp p2)) (equal (car p2) (car p1))))
     
131.               ;(goto_fillet p1 p2)
     
132.               (command "fillet" (car l_pt) (cadr l_pt))  
     
133.             )
     
134.           )
     
135.           (vla-endundomark acaddoc)
     
136.         )
     
137.         ((and p1 (= (type (setq ent (car p1))) 'ename))
     
138.           (vla-startundomark acaddoc)
     
139.           (if (wcmatch (yad-dxf ent 0) "LINE,XLINE,RAY,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE")
     
140.             (goto_fillet p1 nil)
     
141.             (princ "\n圆角需要直线、圆弧、圆、椭圆、多段线或样条曲线！")
     
142.           )
     
143.           (vla-endundomark acaddoc)
     
144.         )
     
145.       )
     
146.     )
     
147.   )
     
148.   (setvar "peditaccept" oldpedit)
     
149.   (setvar "osmode" oldos)
     
150.   (princ)
     
151. )
     
152. (princ "\n框选圆角命令：yad_fillet")
     
153. (princ)

;;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=72665&extra=&highlight=%BD%C7&page=1<br /> (defun c:yad_fillet(/ yad-dxf yad-entsel yad-movetotop yad-interpt goto_fillet oldpedit oldos acaddoc mspace trm p1 p2 prom lprom r boxlen ss l_bak l_pt ent i)<br />   (defun yad-dxf(en val) (cdr (assoc val (entget en))))<br />   (defun yad-entsel(msg filter / ext ent pt s)<br />     (while (not ext)<br />       (setq ent (entsel msg))<br />       (cond<br />         ((= (getvar "errno") 52) (setq ext T) (setvar "errno" 0) nil)<br />         ((and ent (setq s (ssget "_c" (polar (setq pt (cadr ent)) (* pi 1.25) boxlen) (polar pt (/ pi 4) boxlen) filter)) (setq ext T)) (list (ssname s 0) pt))<br />         (T (prompt "\n圆角需要直线、圆弧、圆或多段线！"))<br />       )<br />     )<br />   )<br />   (defun yad-movetotop(l_ent / extdic tbl)<br />     (setq l_ent (mapcar 'vlax-ename->vla-object l_ent))<br />     (setq extdic (vla-getextensiondictionary mspace))<br />     (if (vl-catch-all-error-p (setq tbl (vl-catch-all-apply 'vla-item (list extdic "acad_sortents"))))<br />       (setq tbl (vla-addobject extdic "acad_sortents" "acdbsortentstable"));;;此行显示函数参数个数不正确<br />     )<br />     (vlax-invoke tbl "MoveToTop" l_ent)<br />   )<br />   (defun yad-interpt(obj s / n ent ipt pt l_p)<br />     (setq obj (vlax-ename->vla-object obj) n -1)<br />     (repeat (sslength s)<br />       (setq ent (vlax-ename->vla-object (ssname s (setq n (1+ n)))) ipt (vlax-variant-value (vla-intersectwith obj ent 0)))<br />       (if (and (> (vlax-safearray-get-u-bound ipt 1) 0) (setq ipt (vlax-safearray->list ipt)))<br />         (while (> (length ipt) 0)<br />           (setq pt (list (car ipt) (cadr ipt) (caddr ipt)) ipt (cdddr ipt))<br />           (if (not (vl-member-if '(lambda(e) (equal e pt boxlen)) l_p)) (setq l_p (cons pt l_p)))<br />         )<br />       )<br />     )<br />     (vla-delete obj)<br />     l_p<br />   )<br />   (defun goto_fillet(p1 p2 / ent1 ent2 wid ent2ispl s oldent newent)<br />     (setq ent1 (car p1))<br />     (if (not p2) (redraw ent1 3))<br />     (if (or p2 (setq p2 (yad-entsel "\n选择第二个对象：" '((0 . "LINE,XLINE,RAY,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE")))))<br />       (if (and (setq ent2 (car p2)) (member "LWPOLYLINE" (mapcar '(lambda(e) (yad-dxf e 0)) (list ent1 ent2))))<br />         (progn<br />           (redraw ent1 4)<br />           (if (= (yad-dxf ent2 0) "LWPOLYLINE")<br />             (setq ent1 p2 p2 (cadr p1) ent2 (car p1) p1 (cadr ent1) ent1 (car ent1))<br />             (setq p1 (cadr p1) p2 (cadr p2))<br />           )<br />           (setq wid (yad-dxf ent1 40) ent2ispl (= (yad-dxf ent2 0) "LWPOLYLINE"))<br />           (if (= trm 0)<br />             (progn<br />               (vla-copy (vlax-ename->vla-object ent1))<br />               (if (and ent2ispl (not (equal ent1 ent2))) (vla-copy (vlax-ename->vla-object ent2)))<br />               (yad-movetotop (if (equal ent1 ent2) (list ent1) (list ent1 ent2)))<br />             )<br />             (vl-cmdf "_.undo" "_m")<br />           )<br />           (setvar "qaflags" 1)<br />           (if ent2ispl (vl-cmdf "_.explode" ent1 ent2 "") (vl-cmdf "_.explode" ent1 ""))<br />           (setq s (ssget "_p") oldent (entlast))<br />           (setvar "qaflags" 0)<br />           (vl-catch-all-apply 'vl-cmdf (list "_.fillet" (setq ent1 (nentselp p1)) (setq ent2 (nentselp p2))))<br />           (cond<br />             ((= trm 0))<br />             ((and (equal (setq newent (entlast)) oldent) (/= (getvar "filletrad") 0)) (vl-cmdf "_.undo" "_b"))<br />             (T (vl-catch-all-apply 'vl-cmdf (append (list "_.pedit" (car ent1) "_j")<br />                                               (if (equal newent oldent) nil (list newent))<br />                                               (if (= (yad-dxf (setq ent2 (car ent2)) 0) "CIRCLE") nil (list ent2))<br />                                               (list s "" "_w" wid "")))<br />             )<br />           )<br />           (vl-cmdf "_.erase" s "")<br />         )<br />         (vl-catch-all-apply 'vl-cmdf (list "_.fillet" p1 p2))<br />       )<br />       (redraw ent1 4)<br />     )<br />   )<br />   (vl-load-com)<br />   (setq oldpedit (getvar "peditaccept") oldos (getvar "osmode")<br />     mspace (vla-get-modelspace (setq acaddoc (vla-get-activedocument (vlax-get-acad-object))))<br />   )<br />   (setvar "peditaccept" 1)<br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (setvar "errno" 0)<br />   (vl-cmdf "_.undo" "_c" "_n" "_.undo" "")<br />   (while (/= (getvar "errno") 52)<br />     (princ "\n当前设置：模式 = ")<br />     (princ (if (= (setq trm (getvar "trimmode")) 1) "修剪" "不修剪"))<br />     (princ "，半径 = ")<br />     (princ (getvar "filletrad"))<br />     (initget (if (= trm 1) "U N" "U T"))<br />     (setq p1 (entsel (strcat "\n" (setq prom (strcat "选择对象或指定圆角半径或[放弃(U)/" (if (= trm 1) "不修剪对象(N)" "修剪对象(T)")"]：")))))<br />     (princ "\n")<br />     (setq lprom (getvar "lastprompt") r (substr lprom (1+ (vl-string-mismatch prom lprom)))<br />       boxlen (abs (/ (* (/ (getvar "pickbox") (cadr (getvar "screensize"))) (getvar "viewsize")) (sin (/ pi 4))))<br />     )<br />     (if (numberp (setq r (read r)))<br />       (setvar "filletrad" (abs r))<br />       (cond<br />         ((= p1 "U") (vl-cmdf "_.u"))<br />         ((= p1 "T") (setvar "trimmode" 1))<br />         ((= p1 "N") (setvar "trimmode" 0))<br />         ((and (not p1) (/= (getvar "errno") 52) (setq p2 (getcorner (setq p1 (cadr (grread T 6 2))) "\n指定对角点：")))<br />           (vla-startundomark acaddoc)<br />           (setq ss nil l_bak nil l_pt nil)<br />           (cond<br />             ((and (setq ss (ssget "_f" (list p1 p2) '((0 . "LINE,XLINE,RAY,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))<br />                (vla-addline mspace (vlax-3d-point p1) (vlax-3d-point p2))<br />                (setq l_bak (list ss (setq l_pt (yad-interpt (entlast) ss))))<br />                (> (sslength ss) 1) (> (length l_pt) 1)<br />              )<br />             )<br />             ((and (setq ss (ssget "_f" (list p1 (list (car p1) (cadr p2)) p2 (list (car p2) (cadr p1)) p1) '((0 . "LINE,XLINE,RAY,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))<br />                (vl-cmdf "_.rectang" "_f" 0 p1 p2)<br />                (setq l_pt (yad-interpt (entlast) ss))<br />              )<br />             )<br />           )<br />           (if (and l_bak (or (< (length l_pt) 2) (and (= (sslength ss) 1) (> (length (cadr l_bak)) 1)))) (setq ss (car l_bak) l_pt (cadr l_bak)))<br />           (cond<br />             ((not ss)<br />               (princ "\n没有交叉框选到直线、圆弧、圆、椭圆、多段线或样条曲线！")<br />             )<br />             ((or (= (sslength ss) 1) (= (length l_pt) 1))<br />               (goto_fillet (list (setq ent (ssname ss 0)) (car l_pt)) (if (and (= (yad-dxf ent 0) "LWPOLYLINE") (> (length l_pt) 1)) (list ent (cadr l_pt)) nil))<br />             )<br />             (T<br />               ;(setq p1 (nentselp (car l_pt)) l_pt (cdr l_pt) i -1)<br />               ;(while (and (setq p2 (nth (setq i (1+ i)) l_pt)) (setq p2 (nentselp p2)) (equal (car p2) (car p1))))<br />               ;(goto_fillet p1 p2)<br />               (command "fillet" (car l_pt) (cadr l_pt))  <br />             )<br />           )<br />           (vla-endundomark acaddoc)<br />         )<br />         ((and p1 (= (type (setq ent (car p1))) 'ename))<br />           (vla-startundomark acaddoc)<br />           (if (wcmatch (yad-dxf ent 0) "LINE,XLINE,RAY,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE")<br />             (goto_fillet p1 nil)<br />             (princ "\n圆角需要直线、圆弧、圆、椭圆、多段线或样条曲线！")<br />           )<br />           (vla-endundomark acaddoc)<br />         )<br />       )<br />     )<br />   )<br />   (setvar "peditaccept" oldpedit)<br />   (setvar "osmode" oldos)<br />   (princ)<br /> )<br /> (princ "\n框选圆角命令：yad_fillet")<br /> (princ)

1028695446

既然没人出手，那就我来回答了