[求助]：请高手帮助修改这个程序

PFD8667

这是我从网上下载的[二直线的中心线]的程序,但如图所示中心线没有伸出2～4毫米,不符合国标恳求高手能改为伸出一定的量,先谢谢了!  附上程序:


(defun C:GSL (/ m os e1 en en1 p1 p2 e2 em p3 p4 ang1 ang2
L1 L2 x1 y1 x2 y2 x3 y3 x4 y4 xb yb pb pa ang3 p5
p6 p7 p8 p9 p10 L3 e3 en3 p11 ang3 pc L4 pd p5 p6 La)
(setq m:err *error* *error* *merr*)
(setvar "cmdecho" 0)
(command "UNDO" "G")
(command "UCS" "W")
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq e1 (entsel "\n选择第一条线:"))
(if (= e1 nil)(princ) (progn
(setq en (cdr (assoc '0 (entget (car e1)) )))
(if (/= en "LINE") (princ "\n---所选图元不是直线---")
(progn
(setq en1 (cdr (assoc '-1 (entget (car e1)))))
(redraw en1 3)
(setq p1 (cdr (assoc '10 (entget (car e1)))))
(setq p2 (cdr (assoc '11 (entget (car e1)))))
(setq e2 (entsel "\n选择第二条线:"))
(if (= e2 nil)(princ) (progn
(redraw en1 4)
(setq em (cdr (assoc '0 (entget (car e2)) )))
(if (/= em "LINE") (princ "\n---所选图元不是直线---")
(progn
(setq p3 (cdr (assoc '10 (entget (car e2)))))
(setq p4 (cdr (assoc '11 (entget (car e2)))))
(setq ang1 (angle p1 p2))
(setq ang2 (angle p3 p4))
(setq L1 (distance p1 p2))
(setq L2 (distance p3 p4))
(setq x1 (car p1))(setq y1 (cadr p1))
(setq x2 (car p2))(setq y2 (cadr p2))
(setq x3 (car p3))(setq y3 (cadr p3))
(setq x4 (car p4))(setq y4 (cadr p4))
(setq xb (/ (+ x1 x2 x3 x4) 4.0))
(setq yb (/ (+ y1 y2 y3 y4) 4.0))
(setq pb (list xb yb))
(setq pa (inters p1 p2 p3 p4 nil))
(if (= pa nil)(progn
(setq ang3 (angle p1 p2))
(setq p5 (polar pb ang3 (/ (+ L1 L2) 4.0)))
(setq p6 (polar pb (+ pi ang3) (/ (+ L1 L2) 4.0)))
(command "LINE" p5 p6 "") )
(progn
(setq p7 (cadr e1))
(setq p8 (cadr e2))
(setq p9 (osnap p7 "nearest"))
(setq p10 (osnap p8 "nearest"))
(setq L3 (/ (distance p9 p10) 2.0))
(command "Circle" "ttr" p9 p10 L3)
(setq e3 (entlast))
(setq en3 (cdr (assoc '-1 (entget e3))))
(setq p11 (cdr (assoc '10 (entget e3))))
(setq ang3 (angle pa p11))
(entdel e3)
(setq pc (inters p1 p2 p3 p4))
(if (= pc nil)(progn
(setq L4 (distance pa pb))
(setq pd (polar pa ang3 L4))
(setq p5 (polar pd ang3 (/ (+ L1 L2) 4.0)))
(setq p6 (polar pd (+ pi ang3) (/ (+ L1 L2) 4.0)))
(command "LINE" p5 p6 "") )
(progn
(setq p5 pa)
(setq p6 (polar pa ang3 (/ (+ L1 L2) 4.0)))
(command "LINE" p5 p6 "")
)) ))
(setq La (tblsearch "LAYER" "中心线"))
(if (= La nil)
(command "-layer" "n" "中心线" "c" "4" "中心线" "lt" "中心线" "中心线" ""))
(command "chprop" "L" "" "la" "中心线" "")
)) )) )) ))
(setvar "snapang" 0)
(setvar "osmode" os)
(command "UCS" "P")
(command "UNDO" "E")(princ) )

舟自横

我粗略的看了一下,
你试一下将(command "LINE" p5 p6 "")
前面加上几句(SETQ P5 (POLAR P5 (ANGLE P6 P5) 4))
                        (SETQ P6 (POLAR P6 (ANGLE P5 P6) 4))
其中4是你需要的伸出量.
我没有看完偷懒地想了这个省事的办法,
呵呵,不过猜应该可以...注意有两处要该哦!

PFD8667

舟自横 您好!
太谢谢您了,该程序总算完善了,您讲的"其中4是你需要的伸出量".我不懂编程,我试了一下不行,没有伸出线的量,我受了您的这句话的启发,来回调正数据,发现数据越大而中心线越短,最终调为3.8符合要求,再次感谢您帮助我们这些不会编程的人.