求教动态更改填充比例

chang1622

动态更改填充比例，论坛上版主XYP1964发过此效果图，但不会用！
谁能帮帮忙发个源码，图案为ANI31  角度固定只改比例

xyp1964

1. (defun c:ddbl (/ s1)
   
2.   (if (and (setq s1 (entsel "\n选择: "))
   
3.            (= (xyp-get-dxf 0 (car s1)) "HATCH")
   
4.       )
   
5.     (xyp-Grread-Change s1 "填充角度" 52 3)
   
6.   )
   
7.   (princ)
   
8. )

(defun c:ddbl (/ s1)<br />   (if (and (setq s1 (entsel "\n选择: "))<br />            (= (xyp-get-dxf 0 (car s1)) "HATCH")<br />       )<br />     (xyp-Grread-Change s1 "填充角度" 52 3)<br />   )<br />   (princ)<br /> )

qmqyqj

edata 发表于 2014-5-18 22:38
院长的都是精品，学习的典范。
有时候模仿院长的演示也能锻炼锻炼思维方式。
动态填充比例调整，仅比例。 ...

想问下，这个显示的文字字体怎么修改，在高版本的CAD中使用，中文会显示为 问号&#10067;

qmqyqj

edata 发表于 2014-5-18 22:38
院长的都是精品，学习的典范。
有时候模仿院长的演示也能锻炼锻炼思维方式。
动态填充比例调整，仅比例。 ...

windows10系统下， “当前比例”显示 为 ？？？？号

edata

院长的都是精品，学习的典范。
有时候模仿院长的演示也能锻炼锻炼思维方式。
动态填充比例调整，仅比例。
我的演示：



代码部分（未加出错程序，如果想放弃调整输入s加空格，输入精准比例s加比例（如s100） s后不要空格哦，切记）

1. ;;动态填充比例(only patternscale)
   
2. ;;2014年5月18日
   
3. ;;code by edata @mjtd
   
4. (defun c:tt(/ C_SCALE DS ENT GR MPT OBJ P1 P3 SCREEN_H SCREEN_PT SS TEXT_DS X Y loop scale_p)
   
5.   (vl-load-com)
   
6.   (vla-StartUndoMark (vla-get-activedocument(vlax-get-acad-object)))
   
7.   ;;Get viewpt Sub function from bbs.mjtd.com
   
8.    (defun viewpt(/ a b c d x)
   
9.     (setq b (getvar "viewsize") c (car (getvar "screensize")) d (cadr (getvar "screensize"))
   
10.           a (* b (/ c d)) x (setq x (getvar "viewctr")) x (trans x 1 2) c (list (- (car x)  (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0)
    
11.           d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0) c (trans c 2 1) d (trans d 2 1)
    
12.     )
    
13.     (list c d)
    
14.   )
    
15.   ;;End Sub function
    
16. 
    
17.   ;;Start main function
    
18.     (if(and (setq ss(ssget ":S" '((0 . "hatch"))))
    
19.     (setq ent(ssname ss 0))
    
20.     (car(list t (redraw ent 3))))
    
21.     (progn
    
22.       (setq obj (vlax-ename->vla-object ent)
    
23.       screen_pt(viewpt)
    
24.       screen_h(abs(- (cadr(cadr screen_pt))(cadr(car screen_pt))))
    
25.       loop t)
    
26.       (vla-GetBoundingBox obj 'p1 'p3)
    
27.       (setq p1 (vlax-safearray->list p1)
    
28.       p3 (vlax-safearray->list p3)
    
29.       mpt(mapcar '(lambda(x y)(*(+ x y ) 0.5)) p1 p3)
    
30.       c_scale(vla-get-patternscale obj)
    
31.       text_ds(vlax-ename->vla-object(entmakex (list '(0 . "TEXT")(cons 62 4) (cons 1 (strcat "当前比例为: "(rtos c_scale 2)) ) (cons 10 mpt) (cons 40 (* screen_h 0.04))))))
    
32.       (prompt "\n移动鼠标或输入S比例数字(如s100):")
    
33.       (while (and loop (setq gr(grread t 15 0))(not (or(= (car gr) 3)(= (car gr) 25)(= (car gr) 11)(equal gr '(2 13))(equal gr '(2 32)))))
    
34.   (cond
    
35.     ((= (car gr) 5)(setq p1(cadr gr))     
    
36.      (if(>(setq ds(distance mpt p1))0)(vla-put-patternscale obj (* ds 0.1)))
    
37.      ;(vla-put-patternangle obj (angle mpt p1));改角度
    
38.      (setq screen_pt(viewpt)
    
39.      screen_h(abs(- (cadr(cadr screen_pt))(cadr(car screen_pt)))))
    
40.      (vla-put-insertionpoint text_ds (vlax-3d-point p1))
    
41.      (vla-put-height text_ds (* screen_h 0.04))
    
42.      (vla-put-textstring text_ds (strcat "当前比例为: "(rtos (* ds 0.1) 2)))
    
43.      (vla-update obj)
    
44.      (vla-update text_ds)     
    
45.      (redraw)     
    
46.      (grdraw mpt p1 1 3)     
    
47.      )
    
48.     ((equal gr '(2 115)) (setq loop nil)(if(setq scale_p(getreal "\n输入比例:s"))(vla-put-patternscale obj scale_p)(vla-put-patternscale obj c_scale)))
    
49.     )
    
50.   (entmod (entget ent))
    
51.   (entmod (entget (vlax-vla-object->ename text_ds)))
    
52.   )
    
53.       (and text_ds(vla-delete text_ds))
    
54.       (and text_ds(vlax-release-object text_ds))
    
55.       (and obj(vlax-release-object obj))
    
56.       )
    
57.     )
    
58.   (vla-EndUndoMark (vla-get-activedocument(vlax-get-acad-object)))
    
59.   (redraw)
    
60.   (princ)
    
61.   )
    
62. (prompt "loading dynamic patternscale code by edata,Command is  tt")
    
63. (princ)

;;动态填充比例(only patternscale) <br /> ;;2014年5月18日<br /> ;;code by edata @mjtd<br /> (defun c:tt(/ C_SCALE DS ENT GR MPT OBJ P1 P3 SCREEN_H SCREEN_PT SS TEXT_DS X Y loop scale_p)<br />   (vl-load-com)<br />   (vla-StartUndoMark (vla-get-activedocument(vlax-get-acad-object)))<br />   ;;Get viewpt Sub function from bbs.mjtd.com<br />    (defun viewpt(/ a b c d x)<br />     (setq b (getvar "viewsize") c (car (getvar "screensize")) d (cadr (getvar "screensize"))<br />           a (* b (/ c d)) x (setq x (getvar "viewctr")) x (trans x 1 2) c (list (- (car x)  (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0)<br />           d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0) c (trans c 2 1) d (trans d 2 1)<br />     )<br />     (list c d)<br />   )<br />   ;;End Sub function<br /> <br />   ;;Start main function<br />     (if(and (setq ss(ssget ":S" '((0 . "hatch"))))<br />     (setq ent(ssname ss 0))<br />     (car(list t (redraw ent 3))))<br />     (progn<br />       (setq obj (vlax-ename->vla-object ent)<br />       screen_pt(viewpt)<br />       screen_h(abs(- (cadr(cadr screen_pt))(cadr(car screen_pt))))<br />       loop t)<br />       (vla-GetBoundingBox obj 'p1 'p3)<br />       (setq p1 (vlax-safearray->list p1)<br />       p3 (vlax-safearray->list p3)<br />       mpt(mapcar '(lambda(x y)(*(+ x y ) 0.5)) p1 p3)<br />       c_scale(vla-get-patternscale obj)<br />       text_ds(vlax-ename->vla-object(entmakex (list '(0 . "TEXT")(cons 62 4) (cons 1 (strcat "当前比例为: "(rtos c_scale 2)) ) (cons 10 mpt) (cons 40 (* screen_h 0.04))))))<br />       (prompt "\n移动鼠标或输入S比例数字(如s100):")<br />       (while (and loop (setq gr(grread t 15 0))(not (or(= (car gr) 3)(= (car gr) 25)(= (car gr) 11)(equal gr '(2 13))(equal gr '(2 32)))))<br />   (cond<br />     ((= (car gr) 5)(setq p1(cadr gr))     <br />      (if(>(setq ds(distance mpt p1))0)(vla-put-patternscale obj (* ds 0.1)))<br />      ;(vla-put-patternangle obj (angle mpt p1));改角度<br />      (setq screen_pt(viewpt)<br />      screen_h(abs(- (cadr(cadr screen_pt))(cadr(car screen_pt)))))<br />      (vla-put-insertionpoint text_ds (vlax-3d-point p1))<br />      (vla-put-height text_ds (* screen_h 0.04))<br />      (vla-put-textstring text_ds (strcat "当前比例为: "(rtos (* ds 0.1) 2)))<br />      (vla-update obj)<br />      (vla-update text_ds)     <br />      (redraw)     <br />      (grdraw mpt p1 1 3)     <br />      )<br />     ((equal gr '(2 115)) (setq loop nil)(if(setq scale_p(getreal "\n输入比例:s"))(vla-put-patternscale obj scale_p)(vla-put-patternscale obj c_scale)))<br />     )<br />   (entmod (entget ent))<br />   (entmod (entget (vlax-vla-object->ename text_ds)))<br />   )<br />       (and text_ds(vla-delete text_ds))<br />       (and text_ds(vlax-release-object text_ds))<br />       (and obj(vlax-release-object obj))<br />       )<br />     )<br />   (vla-EndUndoMark (vla-get-activedocument(vlax-get-acad-object)))<br />   (redraw)<br />   (princ)<br />   )<br /> (prompt "loading dynamic patternscale code by edata,Command is  tt")<br /> (princ)

ysq101

版主牛叉啊。。。学习学习。。。一直想写有关于动态的玩意。无奈资质太差

chang1622

非常好！谢谢edata帮助啊。。。学习学习。。。

pxt2001

这个程序很强大，收藏了。

xieyanghui

角度可否支持f8正交呀！

hooboxu

能否出一个可以移动填充图案啊?

yoyoho

感谢 edata 分享程序,不错喔!

lxg3443

在我这里显示的那句  “当前比例为:”  全部为   ？？？？？？ 该怎么办啊

894560869

真厉害啊，谢谢分享了