错误: no function definition: GETREGNEW
本帖最后由 zwq8629 于 2023-7-3 19:39 编辑[*]；请大师改改，输入明天后提示：错误no function definition: GETREGNEW
(defun c:tt( / d1 e e1 h int l m n o obj p pt0 pt1 pt2 pts q ss ss1 test test0 tmp w x z)
(setvar "cmdecho" 0)
(setvar "osmode" 16383)
(setvar "peditaccept" 1)
(setvar "ORTHOMODE" 0);关闭正交
(command "ucs" "w")
(setq TEST0 t)
(while TEST0 ;;循环绘制辅助进刀
(setq TEST t)
(while TEST ;;循环设置参数
;;读取注册表数值:偏距,不存在则赋初始值
(setq d (atof(getregnew regpaths "辅助进刀偏移" "0.25")))
(setq sf '((0 . "LWPOLYLINE")(-4 . "<AND")(-4 . "<NOT")(70 . 1)(-4 . "NOT>")(-4 . "AND>")(-3 ("my_tag"))))
(setq WORD(clh-entsel (STRCAT "\n选择线割图元或[偏移量(D)/取消(空格键)]{当前偏移量:" (rtos d 2 2) "}") "D" sf "\n所选对像不符合要求！请重新选择："))
(cond
;;按下键盘键或者击鼠标右键
((= WORD "D");;修改:偏移量
(if (/= (setq d (getreal (strcat "\n>>指定偏移量 <" (rtos d 2 2) ">: "))) nil)
(setreg regpaths "辅助进刀偏移" (rtos d 2 2))
))
((= WORD nil);;退出
(exit_msg2 "退出")
)
((= (type WORD) 'LIST)(setq TEST nil))
)
);;结束参数设置
(setq pt1 (cadr WORD))
(if (and pt1 (setq ss(ssget pt1 '((0 . "LWPOLYLINE")
(-4 . "<AND")
(-4 . "<NOT")
(70 . 1)
(-4 . "NOT>")
(-4 . "AND>")
(-3 ("my_tag")))
)
)
)
(progn
(setq
e(SSNAME SS 0)
pts(Tao-get-pl-pt e)
p(cadr pts)
)
(while
(and
(setqq (getpoint (trans p 0 1) "\n打断点: "))
(equal p (setq q (vlax-curve-getclosestpointto e (trans q 1 0))) 1e-8)
)
(princ "\n***点必须是不同的***")
)
(if q
(progn
(if(>(setq m(vlax-curve-getparamatpoint e p))(setq n(vlax-curve-getparamatpoint e q)))(mapcar 'set '(m n p q)(list n m q p)))
(setq
e (entget e)
h (reverse (member (assoc 39 e) (reverse e)))
h (subst (cons 70 (logand (cdr (assoc 70 h)) (~ 1))) (assoc 70 h) h)
l (LM:LWVERTICES e)
z (assoc 210 e)
)
(repeat (fix m)
(setq l (cdr l))
)
(if (not (equal m (fix m) 1e-8))
(setq x (car l)
w (cdr (assoc 40 x))
l
(cons
(list
(cons10 (trans p 0 (cdr z)))
(cons40 (+ w (* (- m (fix m)) (- (cdr (assoc 41 x)) w))))
(assoc 41 x)
(cons42
(TAN
(*(- (min n (1+ (fix m))) m)
(atan (cdr (assoc 42 x)))
)
)
)
)
(cdr l)
)
)
)
(setq l (reverse l))
(repeat (+ (length l) (fix m) (- (fix n)) -1)
(setq l (cdr l))
)
(if (not (equal n (fix n) 1e-8))
(setq x (car l)
w (cdr (assoc 40 x))
l
(vl-list*
(list
(cons 10 (trans q 0 (cdr z)))
'(40 . 0.0)
'(41 . 0.0)
'(42 . 0.0)
)
(list
(assoc 10 x)
(assoc 40 x)
(cons41
(+ w
(*(/ (- n (max m (fix n))) (- (1+ (fix n)) (max m (fix n))))
(- (cdr (assoc 41 x)) w)
)
)
)
(cons42
(TAN
(*(if (< (fix n) m) 1.0 (- n (fix n)))
(atan (cdr (assoc 42 x)))
)
)
)
)
(cdr l)
)
)
)
(command "undo" "m")
(setq o(entmakex (append h (apply 'append (reverse l)) (list z))))
(Tao-offset o d 1)
(Erase o)
(setq
e1(entlast)
obj(vlax-ename->vla-object e1)
pt1(vlax-curve-getstartpoint obj)
pt2(vlax-curve-getendpoint obj)
ss1(ssadd)
ss1(ssadd e1 ss1)
)
(if(>(distance(car pts)pt1)(distance(car pts)(cadr pts)))
(progn
(entdel e1)
(setq o(entmakex (append h (apply 'append (reverse l)) (list z))))
(Tao-offset o (- 0 d) 1)
(Erase o)
(setq
e1(entlast)
obj(vlax-ename->vla-object e1)
pt1(vlax-curve-getstartpoint obj)
pt2(vlax-curve-getendpoint obj)
ss1(ssadd)
ss1(ssadd e1 ss1)
)
)
)
(if(null(equal (distance(car pts)pt1) 0.0001))
(progn
(Tao-make-line (car pts) pt1)
(setq ss1(ssadd (entlast) ss1))
)
)
(vl-cmdf "pedit" ss1 "j" ss1 "" "")
(setq ss1(ssadd (entlast) ss1))
(setq dd T)
(while dd
(setq pt0(getpoint (trans pt2 0 1) "\n打断点: "))
(if (/= pt0 nil)
(progn
(Tao-make-line pt0 pt2)
(setq ss1(ssadd (entlast) ss1))
(vl-cmdf "pedit" ss1 "j" ss1 "" "")
(setq pt2 pt0)
)
(setq dd nil)
)
)
)
)
)
)
)
(PRINC)
)
这种程序没有用户的。缺的函数、变量多了去了，粗看一下，以下都缺。
getregnew regpaths clh-entsel setreg Tao-get-pl-pt LMWVERTICES Tao-offset Erase Tao-make-line 缺少GETREGNEW函数 andyding 发表于 2023-7-3 21:17
这种程序没有用户的。缺的函数、变量多了去了，粗看一下，以下都缺。
getregnew regpaths clh-entsel setr ...
是缺好多:'( 拿别人程序不标明出处吗？然后程序不全找其他人补齐？ 帝都划水王 发表于 2023-7-4 16:31
拿别人程序不标明出处吗？然后程序不全找其他人补齐？
问题是我也不知道是谁的啊，我拿到就是这样的:curse: 这个就是小陶线割助手
页:
[1]