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