按照你上面说的方法在CAD2004中试了一下！不行！
命令: vbaload 正在初始化 VBA 系统...<BR>命令: (defun c:GB () (command "-vbarun" "GBChamfer.dvb!thisdrawing.GBChamfer")) <BR>C:GB
命令: gb -vbarun<BR>宏名称(M): GBChamfer.dvb!thisdrawing.GBChamfer<BR>未找到宏。<BR>命令: nil
我试过了应该没有问题啊，我把我的文件上传，11楼的再下载一次试试。
加载工程启用宏，再运行宏就可以用了，输入GB不行
可能这个dvb文件要放到cad的支持目录下才行。
我实在是不会用bva所以用lsp写了一个希望大家一起完善。
;========================<BR>;两垂直线倒内直角<BR>;2004.6.5 ljc<BR>;========================<BR>(defun c:dj( / l ll p1)<BR> (setq cm(getvar "cmdecho") os(getvar "osmode")) <BR> (setvar "cmdecho" 0)<BR> (setq l(car (nentsel "请选择直线1")) h1(getdist "线1切割值:")<BR> ll(car (nentsel "请选择直线2")) h2(getdist "线2切割值:") )<BR> (setq p1 (inters (cdr (assoc 10 (entget l))) (cdr (assoc 11 (entget l)))<BR> (cdr (assoc 10 (entget ll))) (cdr (assoc 11 (entget ll))) nil))<BR> (command "_chamfer" "d" h1 h2) (command)<BR> (command "_chamfer" l ll)<BR> (setq line(entlast))<BR> (setvar "osmode" 0) <BR> (command "rectang" (cdr (assoc 10 (entget line))) <BR> (cdr (assoc 11 (entget line))) )<BR> (command "trim" line "" p1 "") <BR> (setvar "osmode" os)<BR> (command "erase" line "")<BR> (command "explode" (entlast) )<BR> (setvar "cmdecho" cm) (print)<BR> )
能不能完善一下，设置一下默认切割值，像AutoCAD的倒角一样，不设置h1,h2即为1.5，只需选择两条线即可完成命令，而不是要操作4次，同样设置以后即可保存为下次的h1,h2默认值,谢谢!
(defun c:dj( / l ll p1)<BR> (setq cm(getvar "cmdecho") os(getvar "osmode")) <BR> (setvar "cmdecho" 0)<BR> (setq l(car (nentsel "请选择直线1")) h1(getdist "线1切割值:") <BR> ll(car (nentsel "请选择直线2")) h2(getdist "线2切割值:") )
(if h1 setq h1 1.5)(if h2 setq h2 1.5)<BR> (setq p1 (inters (cdr (assoc 10 (entget l))) (cdr (assoc 11 (entget l)))<BR> (cdr (assoc 10 (entget ll))) (cdr (assoc 11 (entget ll))) nil))<BR> (command "_chamfer" "d" h1 h2) (command)<BR> (command "_chamfer" l ll)<BR> (setq line(entlast))<BR> (setvar "osmode" 0) <BR> (command "rectang" (cdr (assoc 10 (entget line))) <BR> (cdr (assoc 11 (entget line))) )<BR> (command "trim" line "" p1 "") <BR> (setvar "osmode" os)<BR> (command "erase" line "")<BR> (command "explode" (entlast) )<BR> (setvar "cmdecho" cm) (print)<BR> )
试一下下面的LISP程序
(DEFUN C:CORNER (/ GETLINE VLINE1 VLINE2 DL1 DL2 PT1 PT2 PT3 PT4 PT5 PT6 PT7 ANG1 ANG2)
(DEFUN GETLINE (MSG / A1)<BR> (INITGET 1)<BR> (SETQ A1 (CAR (ENTSEL MSG)))<BR> (WHILE (/= (CDR (ASSOC 0 (ENTGET A1))) "LINE")<BR> (PRINC "\n您选的不是线图元,请再选一次...")<BR> (INITGET 1)<BR> (SETQ A1 (CAR (ENTSEL MSG)))<BR> )<BR> A1<BR>)
(SETQ VLINE1 (GETLINE "\n请选取第一条线: "))<BR> (WHILE (OR (= VLINE2 nil) (EQUAL VLINE1 VLINE2))<BR> (IF (EQUAL VLINE1 VLINE2) (PRINC "\n线重复,请再选一次..."))<BR> (SETQ VLINE2 (GETLINE "\n请选取第二条线: "))<BR> )<BR> (SETQ D (GETDIST "\n倒角距离 <1.5> : ")<BR> D (IF (= D nil) 1.5 D))<BR> (SETQ DL1 (ENTGET VLINE1) DL2 (ENTGET VLINE2)<BR> PT1 (CDR (ASSOC 10 DL1)) PT2 (CDR (ASSOC 11 DL1))<BR> PT3 (CDR (ASSOC 10 DL2)) PT4 (CDR (ASSOC 11 DL2))<BR> PT5 (INTERS PT1 PT2 PT3 PT4 nil))<BR> (IF (/= PT5 nil) (PROGN<BR> (SETQ PT2 (IF (< (DISTANCE PT5 PT1) (DISTANCE PT5 PT2)) PT2 PT1)<BR> PT4 (IF (< (DISTANCE PT5 PT3) (DISTANCE PT5 PT4)) PT4 PT3)<BR> ANG1 (ANGLE PT5 PT2) ANG2 (ANGLE PT5 PT4)<BR> PT1 (POLAR PT5 ANG1 D) PT3 (POLAR PT5 ANG2 D)<BR> PT5 (POLAR PT3 ANG1 D))<BR> (ENTDEL VLINE1) (ENTDEL VLINE2)<BR> (COMMAND "LINE" PT2 PT1 PT5 PT3 PT4 "")<BR> )<BR> (T (PRINC "\n两直线无交点!"))<BR> )<BR> (PRINC)<BR>)<BR>(PRINC "\nType CORNER to start.")<BR>(PRINC)
谢谢ljcgq，送鲜花一朵!
ljcgq发表于2004-6-20 21:28:00static/image/common/back.gif(defun c:dj( / l ll p1) (setq cm(getvar \"cmdecho\") os(getvar \"osmode\")) (setvar \"cmdecho\" 0) (setq l(car (nentsel ...
(if h1 setq h1 1.5)(if h2 setq h2 1.5)
<BR>上面那行好像有点问题，是不是
(if null h1(setq h1 1.5)) (if null h2(setq h2 1.5))
<BR>