求教lsp程序问题!!!!!

dwt2601

xie le

jdhszh

把线的坐标放在表里删除不要的点，再用划线命令重画一根线，删除原来的，所有搞定，想去哪个去哪个，问题是脑子动一下。

jdhszh

试试这个 (defun C:JDH_SDXCJD()
(setvar "cmdecho" 0)
(setq xlistcord nil)
(write-line "***河南省测绘工程院 金德海 2004年4月***")
(initget "q f d")
(setq qc_flags (getkword "\n请选择Q(全处理)/F(分层处理)/D(选择处理):"))
(if (eq qc_flags "q")
(progn
(command "-layer" "th" "*" "")
(write-line "***本命令用于处理本幅图内所有重迭节点***")
(write-line "将处理较长时间请等候，正在处理······")
(setq S (ssget "x" (list
'(-4 . "<OR")
(cons 0 "lwpolyline")
(cons 0 "polyline")
'(-4 . "OR>")
)))
)
)
(if (eq qc_flags "f")
(progn
(setq pn(strcase(getstring "\n处理线所在层: ")))
(write-line " 请稍候，正在处理······")
(setq S (ssget "x" (list
'(-4 . "<AND")
'(-4 . "<OR")
(cons 0 "lwpolyline")
(cons 0 "polyline")
'(-4 . "OR>")
(cons 8 pn)
'(-4 . "AND>")
)))
)
)
(if (eq qc_flags "d")
(progn
(setq S (ssget (list
'(-4 . "<OR")
(cons 0 "lwpolyline")
(cons 0 "polyline")
'(-4 . "OR>")
)))
(write-line " 请稍候，正在处理······")
)
)
(setq a 0)
(repeat (sslength S)
(setq entname (ssname S a))
(setq eLayer (cdr (assoc '8 (entget entname))))
(setq bh (cdr (assoc '70 (entget entname))))
(setq wide (cdr (assoc '40 (entget entname))))
(setq elistcord (gxfx_getcordList entname)) ;;原表
(cjdb)
(if (eq (vl-consp clistcord ) T)
(progn
(setq lastcord(last elistcord))
(setq fistcord(nth 0 elistcord))
(setq num 0)
(repeat (- (length elistcord) 1)
(setq num1(nth num elistcord))
(setq num2(nth (+ 1 num) elistcord))
(setq dist(distance num1 num2))
(if (> dist 0.001)
(setq xlistcord(cons num1 xlistcord))
)
(setq num (1+ num))
)
(if (> (distance fistcord lastcord) 0.001)(setq xlistcord(cons lastcord xlistcord)))
(if (and (/= bh 1) (< (distance fistcord lastcord) 0.001))(setq xlistcord(cons lastcord xlistcord))) ;;去闭合处重点
(setq elistcord(reverse xlistcord))
)
)
(if (and (/= bh 1) (eq (vl-consp clistcord ) T))
(progn
(setvar "plinewid" wide)
(command "-layer" "s" elayer "")
(setq f_cord (car elistcord))
(command "pline" )
(foreach elem elistcord (command elem))
(COMMAND)
(setq xlistcord nil)
(entdel entname)
)
)
(if (and (= bh 1) (eq (vl-consp clistcord ) T))
(progn
(setvar "plinewid" wide)
(command "-layer" "s" elayer "")
(setq f_cord (car elistcord))
(command "pline" )
(foreach elem elistcord (command elem))
(COMMAND "c")
(setq xlistcord nil)
(entdel entname)
)
)
(setq a (1+ a))
)
(setvar "plinewid" 0)
(setvar "cmdecho" 1)
)
;;;;;;本程序用于获得实体坐标表
(defun gxfx_getcordList (entname / eList eType subent height
subelist subeCord CordList
subeType elem dxfType

)
(setq eList (entget entName))
(setq cordList 'nil)
(setq eType (cdr (assoc '0 eList)))
(cond ((eq eType "POLYLINE")
(setq subent (entnext entName))
(setq subeList (entget subent))
(setq subeCord (cdr (assoc '10 subeList)))
(while (not (eq subeType "SEQEND"))
(setq CordList (cons subeCord CordList))
(setq subent (entnext subent))
(setq subeList (entget subent))
(setq subeCord (cdr (assoc '10 subeList)))
(setq subeType (cdr (assoc '0 subeList)))
)

);;end cond-1; ((eq eType "LWPOLYLINE")
(setq height 'nil)
(foreach elem eList
(setq dxfType (car Elem))
(if (eq dxfType '38)
(progn
(setq height (cdr elem))
)
)
)
(foreach Elem eList
(setq dxfType (car Elem))
(if (eq dxfType 10)
(progn
(if height
(setq subeCord (append (cdr elem)(list height)))
(setq subeCord
(append (cdr Elem)
(list 0.0)
)

);;;
)
(setq CordList (cons subeCord CordList))
)
)
);;end foreach;
);;;end cond;
((eq eType "LINE")
(foreach elem eList
(setq dxfType (car elem))
(if (or (eq dxftype 11)(eq dxftype 10))
(progn
(setq subeCord (cdr elem));;
(setq cordList (cons subecord cordList))
);;
);;
)
);;end cord_3
);;;end cond

(setq cordList (reverse cordList))

);;end defun
(defun CJDB()
;;旧线坐标表 elistcord 重节点表 clistcord
(setq clistcord nil)
(setq i 0)
(repeat (setq mem1(length elistcord))
(setq jd(nth i elistcord))
(setq shjd(vl-remove jd elistcord))
(setq mem2(length shjd))
(if (> (- mem1 mem2) 1)
(setq clistcord(cons jd clistcord))
)
(setq i (1+ i))
)
) szhjdh@sohu.com