yang686526

[求助]求一个刷子的程序
www.dimcax.com
[求助]求一个刷子的程序
我需要一个子程序，类似于entsel命令的功能，选择一个字符串。只是选择目标前动态显示刷子，选择完毕刷子结束。
看到caoyin老大发过一个刷子的程序，只是小弟初学编程，看了几天都没有搞懂，哪位高手能帮我改一下？谢谢。
caoyin老大的源程序如下：
;;____________________________________________________________________________________________________
;; ▓ (lt:match )
;; [功能] 模仿 matchprop 刷子功能
;; [参数] pt-------刷子动态起始点
;; col------表 (刷子颜色 选择框颜色)
;; ssparm---表，选择参数。(命令行打印信息 图元属性过滤)
;; fun------函数名
;;[测试]
(defun c:matxt (/ e ed ss) ;; 文字内容匹配
;(lt:error-init (list nil 0 nil nil))
(setq e (entsel "\n选择源文字对象: " )
)
(if (not e) (exit))
(setq ed (cons 1 (cdr (assoc 1 (entget (car e))))))
(lt:match
(cadr e)
'(2 3)
(list "\n选择目标文字对象: " '((0 . "*text,dimension")))
'(lambda (x / ent)
(setq ent (entget x))
(entmod (subst ed (assoc 1 ent) ent))
)
)
;(lt:error-restore)
)
(defun lt:match (pt col ssparm fun / d_brush pickbox p2u len x y msg pt1 ss1 pt2 co i e ss)
(defun d_brush (col x y len / a b c)
(grvecs (list col (list (- x (setq a (* len 1.5))) (- y len))
(list (- x a) (setq b (- y (* len 7.5))))
col (list (- x (setq c (* len 0.5))) y)
(list (- x c) b)
col (list (+ x c) y)
(list (+ x c) b)
col (list (+ x a) (- y len))
(list (+ x a) b)
col (list (- x (setq a (* len 4.5))) b)
(list (+ x a) b)
col (list (- x a) b)
(list (- x (setq c (* len 6.5))) (- y (* len 9)))
col (list (+ x a) b)
(list (+ x c) (setq a (- y (* len 9))))
col (list (- x c) a)
(list (- x c) (setq b (- y (* len 17))))
col (list (+ x c) a)
(list (+ x c) b)
col (list (- x c) (setq a (- y (* len 10))))
(list (+ x c) a)
col (list (- x c) (setq a (- y (* len 11))))
(list (+ x c) a)
col (list (- x c) (setq a (- y (* len 13))))
(list (+ x c) a)
col (list (- x c) (setq a (- y (* len 14))))
(list (+ x c) a)
col (list (- x c) b)
(list (+ x c) b)
col (list (- x c) b)
(list (- x (* len 11)) (setq a (- y (* len 21.5))))
col (list (- x (* len 2)) b)
(list (- x (* len 6.5)) a)
col (list (+ x (* len 2)) b)
(list (- x (* len 2.5)) a)
col (list (+ x c) b)
(list (+ x (* len 2)) a)
col (list (- x (* len 11)) a)
(list (+ x (* len 3)) a)
)
(list (list 1 0 0 (* len 14))
(list 0 1 0 (* len -4)) '(0 0 1 0) '(0 0 0 1)
)
)
)
(defun pickbox (pt / si cv)
(setq si (* (/ (getvar "pickbox") (cadr (getvar "screensize"))) (getvar "viewsize") 0.5)
cv (list si si 0)
)
(list (mapcar '+ pt cv) (mapcar '- pt cv))
)
(defun p2u (pix) (* pix (/ (getvar "viewsize") (cadr (getvar "screensize")))))
(or (setq co (cadr col)) (setq co 7))
(or (setq col (car col)) (setq col 7))
(or (setq msg (car ssparm)) (setq msg "\n选择目标对象: "))
(setq ssparm (cadr ssparm) len (p2u 1) x (car pt) y (cadr pt))
(princ msg)
(while (/= (car pt1) 11)
(redraw)
(d_brush col x y len)
(while (not (member (car (setq pt1 (grread t 12 2))) '(3 11)))
(setq pt1 (cadr pt1))
(if (vl-consp pt1)
(progn
(if (> (distance pt1 pt) (p2u (* 0.0001 (car (getvar "screensize")))))
(progn
(redraw)
(setq len (p2u 1) x (car pt) y (cadr pt))
(d_brush col x y len)
(setq pt pt1)
)
)
)
)
)
(redraw)
(if (and (= (car pt1) 3)
(princ msg)
(not (setq ss1 (apply 'ssget (append '("_c") (pickbox (cadr pt1)) (list ssparm)))))
)
(progn
(princ "指定对角点: ")
(setq pt1 (list (caadr pt1) (cadadr pt1)))
(while (not (member (car (setq pt2 (grread t 12 1))) '(3 11)))
(setq pt2 (list (caadr pt2) (cadadr pt2)))
(if (vl-consp pt1)
(progn
(if (> (distance pt2 pt) (p2u (* 0.0001 (car (getvar "screensize")))))
(progn
(redraw)
(setq len (p2u 1) x (car pt) y (cadr pt) co (abs co))
(if (> (car pt1) (car pt2)) (setq co (- co)))
(d_brush col x y len)
(grvecs (list co pt1 (list (car pt1) (cadr pt2))
co pt2 (list (car pt1) (cadr pt2))
co pt2 (list (car pt2) (cadr pt1))
co pt1 (list (car pt2) (cadr pt1))
)
)
(setq pt pt2
ss1 (ssget (if (minusp co) "_c" "_w") pt1 pt2 ssparm)
)
)
)
)
)
)
)
)
(or ss (setq ss (ssadd)))
(if ss1
(repeat (setq i (sslength ss1))
(setq e (ssname ss1 (setq i (1- i))))
(ssadd e ss)
(redraw e 3)
(apply fun (list e))
))
(setq ss1 nil)
)
(redraw)
ss
)
d
没人帮我一下吗？我又研究了几天，还不行。郁闷
d
(defun c:tt (/ pt x y col pt1 en)
(setq col 1) ;;控制刷子颜色
(princ "\n选择对象: ")
(while (not (member (car (setq pt1 (grread t 12 2))) '(3 11)))
(setq pt1 (cadr pt1))
(if (vl-consp pt1)
(progn
(or pt (setq pt pt1))
(setq x (car pt) y (cadr pt))
(if (> (distance pt1 pt) (p2u (* 0.0001 (car (getvar "screensize")))))
(progn
(redraw)
(setq len (p2u 1) x (car pt) y (cadr pt))
(d_brush col x y len)
(setq pt pt1)
)
)
)
)
)
(redraw)
(and (= (car pt1) 3)
(vl-consp (cadr pt1))
(setq en (nentselp (cadr pt1)))
)
en
)
d
终于搞定了，谢谢老大
d