[求助]ZZXXQQ能不能帮忙编个程序?拜托了!!

jaminth

时间紧迫,ZZXXQQ能不能帮忙编个程序:

要求能一次框选多个带有属性的块,并把块中的属性高度改为同一高度,颜色改为同一种颜色!?

我也能写写,可工程较紧,最近经常加班!想自己写,可技术不太熟练,每次写一个LISP都要调试好几次!麻烦你了!

ZZXXQQ

只给要求不知属性是什么结构如何写？再说我也总加班呀！

jaminth

下面是我自已写的"匹配块属性内容"的一个LISP,可是每次运行只能匹配一个目标的属性!如果ZZXXZQQ您能够帮我修改一下(效果是:选择源属性块后,再一次框选多个带有属性的块,结果可以把块中的属性内容改为同一内容!),那我从您的修改那里一定可以得到启示,相信我自己也可以写出"匹配块属性高度各颜色"的LISP.
下面我的这个LISP,是用来匹配带有标高的属性块!我这个贴子的原先求助是想:修改多个"标高"的属性块的
高度各颜色!

2. (defun c:at ( / att1 att2 en_data en_data2 enrr1 enrr2 ent1 ent2)
3.    (setq ent1 (nentsel "\n选择源属性块的"属性":"))
4.    (setq en_data (entget (setq enrr1 (car ent1))))
5.    (setq att1 (assoc 1 en_data))
6.    (setq ent2 (nentsel "\n选择匹配目标的"属性":"))
7.    (setq en_data2 (entget (setq enrr2 (car ent2))))
8.    (setq att2 (assoc 1 en_data2))
9.    (setq en_data2 (subst att1 att2 en_data2))
10.    (entmod en_data2)
11.    (entupd enrr2)
12. )

(defun c:at ( / att1 att2 en_data en_data2 enrr1 enrr2 ent1 ent2)    (setq ent1 (nentsel "\n选择源属性块的"属性":"))    (setq en_data (entget (setq enrr1 (car ent1))))    (setq att1 (assoc 1 en_data))    (setq ent2 (nentsel "\n选择匹配目标的"属性":"))    (setq en_data2 (entget (setq enrr2 (car ent2))))    (setq att2 (assoc 1 en_data2))    (setq en_data2 (subst att1 att2 en_data2))    (entmod en_data2)    (entupd enrr2) )

ivde

2. (defun c:tt ()
3.   (vl-catch-all-apply
4.     '(lambda (/ col h)
5.        (if (and    (ssget '((0 . "insert") (66 . 1)))
6.         (setq col (acad_colordlg 1))
7.         (setq h (getdist "\nHeight: "))
8.        )
9.      (vlax-for obj
10.            (vla-get-activeselectionset
11.              (vla-get-activedocument (vlax-get-acad-object))
12.            )
13.        (foreach x (vlax-invoke obj 'getattributes)
14.          (vla-put-color x col)
15.          (vla-put-height x h)
16.        )
17.      )
18.        )
19.      )
20.   )
21.   (princ)
22. )

(defun c:tt ()   (vl-catch-all-apply     '(lambda (/ col h)        (if (and    (ssget '((0 . "insert") (66 . 1)))         (setq col (acad_colordlg 1))         (setq h (getdist "\nHeight: "))        )      (vlax-for obj            (vla-get-activeselectionset              (vla-get-activedocument (vlax-get-acad-object))            )        (foreach x (vlax-invoke obj 'getattributes)          (vla-put-color x col)          (vla-put-height x h)        )      )        )      )   )   (princ) )

jaminth

谢谢ivde!
我修改了一下,加入了旋转角度的功能,例如输入了45,完成后,我再双击属性块,可看到的"旋转"却是58.31007808870452,麻烦ivde解决一下!!

2. (defun c:art ( / col h obj r x)
3. (vl-catch-all-apply
4.    '(lambda (/ col h)
5.        (if (and    (ssget '((0 . "insert") (66 . 1)))
6.        (setq col (acad_colordlg 1))
7.   ; (setq col (getdist "\ncolor: "))
8.         (setq h (getdist "\nHeight: "))
9.         (setq r (getdist "\Rotation: "))
10.       )
11.     (vlax-for obj
12.           (vla-get-activeselectionset
13.             (vla-get-activedocument (vlax-get-acad-object))
14.           )
15.       (foreach x (vlax-invoke obj 'getattributes)
16.         (vla-put-color x col)
17.         (vla-put-height x h)
18.         (vla-put-Rotation x r)
19.       )
20.     )
21.       )
22.     )
23. )
24. (princ)
25. )

(defun c:art ( / col h obj r x) (vl-catch-all-apply    '(lambda (/ col h)        (if (and    (ssget '((0 . "insert") (66 . 1)))        (setq col (acad_colordlg 1))   ; (setq col (getdist "\ncolor: "))         (setq h (getdist "\nHeight: "))         (setq r (getdist "\Rotation: "))       )     (vlax-for obj           (vla-get-activeselectionset             (vla-get-activedocument (vlax-get-acad-object))           )       (foreach x (vlax-invoke obj 'getattributes)         (vla-put-color x col)         (vla-put-height x h)         (vla-put-Rotation x r)       )     )       )     ) ) (princ) )

ZZXXQQ

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

jaminth

谢谢ZZXXQQ，也谢谢ivde!让我见识到vla函数威力，短短的几行就把问题给解决了！

yxtop

谢谢

头大无恼

不错

董堃

ZZXXQQ

高高手来的