[求助]

bhf0114

各位老大帮忙:

citykunan

你上面的字我看也看不见，能不能传张图上来？

bhf0114

citykunan发表于2004-3-12 9:10:00你上面的字我看也看不见，能不能传张图上来？

你单击图片即可在新窗口中放大

ljcgq

(defun c:tt( / a1 a2 p1 p2 p3 p4 p5 p6 os)
(setq a1( entget (car (nentsel) ) ) ) (setq a2( entget (car (nentsel) ) ) os (getvar "osmode") )
(setq p1 (cdr ( assoc 10 a1 )) p2 (cdr ( assoc 11 a1 ))
p3 (cdr ( assoc 10 a2 )) p4 (cdr ( assoc 11 a2 )) )
(setq p5 (inters p1 p2 p3 p4 nil))
(setvar "osmode" 0)
(if (> (distance p5 p1) (distance p5 p2) ) (setq p6 p2) (setq p6 p1))
(command "line" p5 (mapcar '(lambda (x y) (/ (+ x y) 2 ) ) p5 p6 ) "" )
(command "change" (entlast) "" "p" "c" 3 "")
(if (> (distance p5 p3) (distance p5 p4) ) (setq p6 p4) (setq p6 p3))
(command "line" p5 (mapcar '(lambda (x y) (/ (+ x y) 2 ) ) p5 p6 ) "" )
(command "change" (entlast) "" "p" "c" 3 "")
(setvar "osmode" os)
) 我在cad2004上运行通过了,你看看好使么.

bhf0114

ljcgq :你好!谢谢你帮我编写程序,不过还有些问题想请教你,就是好如果我新建一个文件测试程序时很正常,如果我打开一个旧文件测试则出现如下情况:见图片

meflying

可能是UCS坐标问题，你使用前使用UCS命令，然后直接回车，就是到WCS里执行程序，执行完后UCS P恢复，，，也可以将它直接加到程序里

ljcgq

meflying说的很对,是坐标系的问题.程序我改了一下,可以避免ucs造成的错误: (defun c:tt( / a1 a2 p1 p2 p3 p4 p5 p6 os)
(setq a1( entget (car (nentsel) ) ) ) (setq a2( entget (car (nentsel) ) ) os (getvar "osmode") )
(setq p1 (cdr ( assoc 10 a1 )) p2 (cdr ( assoc 11 a1 ))
p3 (cdr ( assoc 10 a2 )) p4 (cdr ( assoc 11 a2 )) )
(setq p5 (inters p1 p2 p3 p4 nil))
(setvar "osmode" 0)
[I](command "ucs" "" "") ;edit[/I]
(if (> (distance p5 p1) (distance p5 p2) ) (setq p6 p2) (setq p6 p1))
(command "line" p5 (mapcar '(lambda (x y) (/ (+ x y) 2 ) ) p5 p6 ) "" )
(command "change" (entlast) "" "p" "c" 3 "")
(if (> (distance p5 p3) (distance p5 p4) ) (setq p6 p4) (setq p6 p3))
(command "line" p5 (mapcar '(lambda (x y) (/ (+ x y) 2 ) ) p5 p6 ) "" )
(command "change" (entlast) "" "p" "c" 3 "")
[I] (command "ucs" "p" "") ;edit[/I]
(setvar "osmode" os)
)