明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 346|回复: 1

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

[复制链接]
发表于 2020-6-24 07:23 | 显示全部楼层 |阅读模式
5明经币
本帖最后由 yangchao2005090 于 2020-6-24 13:48 编辑

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


最佳答案

查看完整内容

既然没人出手,那就我来回答了
发表于 2020-6-24 07:23 | 显示全部楼层
本帖最后由 1028695446 于 2020-6-24 19:47 编辑

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-28 18:45 , Processed in 0.188285 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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