[求助]：检查悬挂点、删除重复点

lihy203

我是新手，现在想通过LISP写几个简单的检查工具
希望高手给点方法
如果能有源代码，那小弟万分感激
检查悬挂点和删除重复点

dong790518

期待中

PLgis

也许楼主觉得不言自明，实际上知者甚少
请说明，什么是“悬挂点”“重复点”才好

zml84

http://zml84.blog.sohu.com/112996795.html

dong790518

hsao

lrl2006

(prompt "\n●***多段线除重点***●\n◎§※命令：DESP※§◎")
(defun c:DESP( / l Sel data newdata en enp js_n)
   (Setvar "Cmdecho" 0)
  (Prompt "\n\r★☆★选择需要处理的多段线：")
  (SetQ Sel (SsGet (list(cons 0  "lwpolyline")))
L   (SsLength Sel)   ;;获取对象
m   0
js_n  0
  )
  (Repeat L
    (SetQ en   (SsName Sel m)
        data(entget en)
        n 0
enp_js t
newdata NIL
   js    nil
   
  )
(while
  enp_js
   (setq enp(nth n data))    ;;对组码进行循环，找出重复点
   (if(and (member enp newdata)(= 10(car enp)))
     (progn
     (setq n (+ n 3)
           js T)
     )
     (setq newdata (cons enp newdata))   ;;筛选组码，去重点
     )
   (setq n (1+ n))
   (setq enp_js(nth n data))
   )
(setq newdata(reverse newdata)
      m (1+ m)
      )

(entmod newdata)           ;;更新图元，得到没有重复点的多段线
    (if js
      (setq js_n (1+ js_n))
    )
    )
   (Setvar "Cmdecho" 1)
  (princ "\n▲◆§共处理多段线条数=")
    js_n

)

   
(defun mzz()
(setq scl0 (getvar "ltscale") )
(setq scl scl0)
(setq aa (rtos (* scl0 1000) 2 0))
(setq yy1 nil)
(setq aa (strcat "测图比例尺:" aa ">:") )
(setq scl1 (getint aa))
(if (and (> scl1 100) (< scl1 1000000))(progn
          (setq scl (/ scl1 1000.0))
          (command"ltscale" scl)
       ))
)
(mzz)
(defun c:tt()
  (mzz)
)
(defun c:imatab()
   ;(setq im (entsel "\n选择定位影象>:" ))
   (setq im (ssget ))
   (initget "1 2 3")
   (setq opt (getkword
      "\n1：4*5 /2: 5*5 /3: ：通用算法 "))
   (tab2)
)

(defun tab2()
   (setq p1 (getpoint "\n选择定位点1>:"))
   (setq p3 (getpoint "\n输入定位点1绝对坐标>:"))
   (setq p2 (getpoint "\n选择定位点2>:"))
   
      (cond
        ((= opt "1") (setq p4 (list (+ (nth 0 p3) (* 500 scl)) (+ (nth 1 p3) (* 400 scl))) ) )
        ((= opt "2") (setq p4 (list (+ (nth 0 p3) (* 500 scl)) (+ (nth 1 p3) (* 500 scl)))))
        ((= opt "3") (setq p4 (getpoint "\n输入定位点2绝对坐标>:")))
      )


   (sbtab)
   (command "rectang" p3 p4)
   (setq object (entlast))
    (xd object "999998")
   (command "change" object "" "p" "la" "0" "C" 1 "" "")
   (command"change" object "" "p" "lt" "continuous" "")
   (command"pedit" object "w" 0 "")

)
(defun sbtab()
   (setq ang_r  (- (angle p3 p4 )  (angle p1 p2) ) )
   (setq a  (/ (distance p3 p4) (distance p1 p2) ))
   (command "scale" im "" p1 a)
   (command "rotate" im "" p1 (angtos ang_r 2 8))
   (command "move" im "" p1 p3)
   (command "transparency" im "" "on")
   (command "zoom" "e" )
   (command "draworder" im "" "b") (princ)

)