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