需要帮个忙!

kaixin119

我以前在论坛上找了个程序,可现在找不到在论坛的什么地方,也搜不到,这是可以连接断开的曲线(等高线)的,可用来接图,可现在调出来用出问题了,可能是丢了什么东西!!我是新手,拜托大家了!! (defun c:ni()
(load"qx")
(command"layer""unlock" "dgx" "")
;(command"zoom" "e")
(cWPOLYLINE)
(setq ent (ssget "x" '((8 . "dgx")(0 . "POLYLINE"))))
(if ent (progn
(setq long-ent (sslength ent))
(setq num-ent 0)
(write-line"\n　　 ***正在拟合等高线.....")
(repeat long-ent
(setq ty (ssname ent num-ent))
;(Setq ty (car (entsel)))
(c:get-yuanma)
(c:get-listnew)
(c:regen-line)
(setq num-ent (1+ num-ent))
)
(write-line"\n　　拟合完毕,请检查大拐弯处是否有点线矛盾！")
);progn
(write-line"\n 图形中没有等高线")
);if
(print)
) (defun c:get-yuanma()
(command"pedit" ty "d" "")
(c:max-min)
(Setq data-dgx (entget ty))
(setq tc (assoc 8 data-dgx)
line-type (assoc 6 data-dgx)
width (cdr (assoc 40 data-dgx))
thi (cdr (assoc 39 data-dgx))
color (cdr (assoc 62 data-dgx))
)
) (defun cWPOLYLINE()
(setq ent (ssget"x" '((8 . "dgx")(0 . "LWPOLYLINE"))))
(if ent (progn
(setq long-ent (sslength ent))
(setq num-ent 0)
(repeat long-ent
(setq ty (ssname ent num-ent))
(command"pedit" ty "f" "")
(setq num-ent (1+ num-ent))
)
))
) (defun c:get-listnew() ;减掉过密顶点
(setq long-new (length list-p))
(Setq p-listnew (list (car list-p)))
(setq num-new 0 k 0)
(setq p1 (nth num-new list-p))
(setq num-new (1+ num-new))
(while (setq p2　(nth num-new list-p))
(setq dis (distance p1 p2))
(if (< dis 5.0) (progn
(setq num-new (1+ num-new))
(while (and (< dis 5.0)(> long-new num-new))
(setq p2　(nth num-new list-p))
(setq dis (distance p1 p2))
(setq num-new (1+ num-new))
)
(setq p-listnew (append p-listnew (list p2)))
);progn
(setq p-listnew (append p-listnew (list p2)))
)
(setq p1 p2)
(setq num-new (1+ num-new))
);while
(setq d-end (distance (last p-listnew) (last list-p)))
(if (/= 0 d-end)
(setq p-listnew (append p-listnew (list (last list-p))))
)
);defun (defun c:regen-line()
(command"erase" ty "")
(command "pline")
(apply 'command p-listnew)
(command "")
(command"pedit" (entlast) "w" width "s" "")
(command"change" (entlast) "" "p" "t" thi "")
(setq data-line (entget (entlast)))
(setq tc-old (assoc 8 data-line)
line-typeold (assoc 6 data-line)
)
(setq da (subst line-type line-typeold data-line))
(entmod da)
(setq da (subst tc tc-old data-line))
(entmod da)
(if color (command"change" (entlast) "" "p" "c" color ""))
)

meflying

(load "qx")


这里的qx文件没有，所以没办法了

kaixin119

哦,谢谢,没办法了?

jhkdyhl1

同问中。。。。。