|
我需要一个子程序，类似于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
)
| 
发表于 2009-3-13 22:07:00
置顶卡
变色卡
显身卡
楼主
发表于 2009-3-16 09:07:00
