[求助]一個特殊的倒角程序

钾肥

按照你上面说的方法在CAD2004中试了一下！不行！ 命令: vbaload 正在初始化 VBA 系统...
命令: (defun c:GB () (command "-vbarun" "GBChamfer.dvb!thisdrawing.GBChamfer"))
C:GB 命令: gb -vbarun
宏名称(M): GBChamfer.dvb!thisdrawing.GBChamfer
未找到宏。
命令: nil

subtlation

我试过了应该没有问题啊，我把我的文件上传，11楼的再下载一次试试。


       

wolaikk

加载工程启用宏，再运行宏就可以用了，输入GB不行

subtlation

可能这个dvb文件要放到cad的支持目录下才行。

ljcgq

我实在是不会用bva所以用lsp写了一个希望大家一起完善。 ;========================
;两垂直线倒内直角
;2004.6.5 ljc
;========================
(defun c:dj( / l ll p1)
(setq cm(getvar "cmdecho") os(getvar "osmode"))
(setvar "cmdecho" 0)
(setq l(car (nentsel "请选择直线1")) h1(getdist "线1切割值:")
ll(car (nentsel "请选择直线2")) h2(getdist "线2切割值:") )
(setq p1 (inters (cdr (assoc 10 (entget l))) (cdr (assoc 11 (entget l)))
(cdr (assoc 10 (entget ll))) (cdr (assoc 11 (entget ll))) nil))
(command "_chamfer" "d" h1 h2) (command)
(command "_chamfer" l ll)
(setq line(entlast))
(setvar "osmode" 0)
(command "rectang" (cdr (assoc 10 (entget line)))
(cdr (assoc 11 (entget line))) )
(command "trim" line "" p1 "")
(setvar "osmode" os)
(command "erase" line "")
(command "explode" (entlast) )
(setvar "cmdecho" cm) (print)
)

alan_cmh

能不能完善一下，设置一下默认切割值，像AutoCAD的倒角一样，不设置h1,h2即为1.5，只需选择两条线即可完成命令，而不是要操作4次，同样设置以后即可保存为下次的h1,h2默认值,谢谢!

ljcgq

(defun c:dj( / l ll p1)
(setq cm(getvar "cmdecho") os(getvar "osmode"))
(setvar "cmdecho" 0)
(setq l(car (nentsel "请选择直线1")) h1(getdist "线1切割值:")
ll(car (nentsel "请选择直线2")) h2(getdist "线2切割值:") ) (if h1 setq h1 1.5)(if h2 setq h2 1.5)
(setq p1 (inters (cdr (assoc 10 (entget l))) (cdr (assoc 11 (entget l)))
(cdr (assoc 10 (entget ll))) (cdr (assoc 11 (entget ll))) nil))
(command "_chamfer" "d" h1 h2) (command)
(command "_chamfer" l ll)
(setq line(entlast))
(setvar "osmode" 0)
(command "rectang" (cdr (assoc 10 (entget line)))
(cdr (assoc 11 (entget line))) )
(command "trim" line "" p1 "")
(setvar "osmode" os)
(command "erase" line "")
(command "explode" (entlast) )
(setvar "cmdecho" cm) (print)
)

ZZXXQQ

试一下下面的LISP程序 (DEFUN C:CORNER (/ GETLINE VLINE1 VLINE2 DL1 DL2 PT1 PT2 PT3 PT4 PT5 PT6 PT7 ANG1 ANG2) (DEFUN GETLINE (MSG / A1)
(INITGET 1)
(SETQ A1 (CAR (ENTSEL MSG)))
(WHILE (/= (CDR (ASSOC 0 (ENTGET A1))) "LINE")
(PRINC "\n您选的不是线图元,请再选一次...")
(INITGET 1)
(SETQ A1 (CAR (ENTSEL MSG)))
)
A1
) (SETQ VLINE1 (GETLINE "\n请选取第一条线: "))
(WHILE (OR (= VLINE2 nil) (EQUAL VLINE1 VLINE2))
(IF (EQUAL VLINE1 VLINE2) (PRINC "\n线重复,请再选一次..."))
(SETQ VLINE2 (GETLINE "\n请选取第二条线: "))
)
(SETQ D (GETDIST "\n倒角距离 <1.5> : ")
D (IF (= D nil) 1.5 D))
(SETQ DL1 (ENTGET VLINE1) DL2 (ENTGET VLINE2)
PT1 (CDR (ASSOC 10 DL1)) PT2 (CDR (ASSOC 11 DL1))
PT3 (CDR (ASSOC 10 DL2)) PT4 (CDR (ASSOC 11 DL2))
PT5 (INTERS PT1 PT2 PT3 PT4 nil))
(IF (/= PT5 nil) (PROGN
(SETQ PT2 (IF (< (DISTANCE PT5 PT1) (DISTANCE PT5 PT2)) PT2 PT1)
PT4 (IF (< (DISTANCE PT5 PT3) (DISTANCE PT5 PT4)) PT4 PT3)
ANG1 (ANGLE PT5 PT2) ANG2 (ANGLE PT5 PT4)
PT1 (POLAR PT5 ANG1 D) PT3 (POLAR PT5 ANG2 D)
PT5 (POLAR PT3 ANG1 D))
(ENTDEL VLINE1) (ENTDEL VLINE2)
(COMMAND "LINE" PT2 PT1 PT5 PT3 PT4 "")
)
(T (PRINC "\n两直线无交点!"))
)
(PRINC)
)
(PRINC "\nType CORNER to start.")
(PRINC)

alan_cmh

谢谢ljcgq，送鲜花一朵!

alan_cmh

ljcgq发表于2004-6-20 21:28:00(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)
上面那行好像有点问题，是不是 (if null h1(setq h1 1.5)) (if null h2(setq h2 1.5))