UG散散心 发表于 2014-11-12 18:07:54

刚开始学习autocad的VBA,请大侠帮帮忙~

不知道能不能用Macro,或者VBA来实现下面的工作:

1.在模型空间,插入一个已经在的 块,比如:名字为 “KK”, 效果是 能在工具条上创建按钮, 点击之后,只需要在屏幕上 点取 位置就能放置 块(有炸开 和 非炸开两种模式最好,做成两个按钮)。

2.在模型空间,进行 指定条件的筛选(2007自带快速选择功能),然后把筛选出来的一类目标的某些特性修改为另外的特性, 比如: 选择 所有 线型=Center 的目标,然后,把这些目标全部移动到 图层:200, 颜色=Bylayer,线型=Bylayer,线宽=Bylayer。 同样也做成按钮,放在工具条上~

求各位大侠帮忙哈~

zsdwx 发表于 2014-11-12 19:52:54

Q1:这个我用autolisp实现过,点中自己制作的按钮,再点选标题栏左下角,就可以在设计栏中插入制作好的签名块并在后面写上当前日期。用VBA应该一样能行的。

zsdwx 发表于 2014-11-12 19:56:26

(defunc:name(/ pt pt1 p1 p2 yy mm dd s text1 osd layer_old rr)
(setq osd (getvar "osmode"))
(setq pt0 '(142.0 5.0))
(initget 128)
(setq pt (getpoint "\n请选取签名插入点"))
(if (= pt nil)
      (setq pt pt0)
)
            (setq pt1 (polar pt (/ pi 6) 35))
            (setq pt2 (polar pt1 (/ pi 8) 3))
            (setq sse (ssget "_c" pt1 pt2))
            (command "erase" sse "")

(command "insert" "n1" pt "" "" "")
(setq s (getvar "cdate"))
(setq rr (- (* s 100000000) (fix (* s 100000000))))
(setq yy (fix (/ s 10000)))
(setq mm (fix (/ (- s (* yy 10000)) 100)))
(setq dd (fix (/ (- s (* (fix (/ s 100)) 100)))))
(setq text1 (strcat (rtos yy) "/" (rtos mm) "/" (rtos dd)))
(setq p1 (polar pt (* 41 (/ pi 180.0)) 44.0))
(setq p2 (polar pt (* 0 (/ pi 180.0)) (+ 50.0 rr)))
(command "style" "txt" "txt.shx,gbcbig.shx" "" 0.85 "" "" "" "")
(setq layer_old (getvar "clayer"))
(setvar "clayer" "text")
(setvar "osmode" 0)
(command "text" p1 2 0 text1)
(setvar "cecolor" "40")
(command "point" p2)
(setvar "cecolor" "bylayer")
(setvar "clayer" layer_old)
(setvar "osmode" osd)
(princ)
)

UG散散心 发表于 2014-11-12 20:27:18

zsdwx 发表于 2014-11-12 19:56 static/image/common/back.gif
(defunc:name(/ pt pt1 p1 p2 yy mm dd s text1 osd layer_old rr)
(setq osd (getvar "osmode"))
   ...

感谢回复,功能很好,能省下不少时间,不过我才刚入门,看不懂 ~。~

UG散散心 发表于 2014-11-12 21:34:01

还请各位大侠帮帮忙哈~:o

UG散散心 发表于 2014-11-13 18:23:07

第一个问题,自己在公司摸索了一上午, 大概能用了,能插入 命名为KK的块了,但是不会炸开
直接用宏命令做的,
^C^C-insert KK \1 1 0
第二个,完全找不到方向~
页: [1]
查看完整版本: 刚开始学习autocad的VBA,请大侠帮帮忙~