找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1646|回复: 5

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

[复制链接]
发表于 2009-3-25 17:56:43 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
我是新手,现在想通过LISP写几个简单的检查工具
希望高手给点方法
如果能有源代码,那小弟万分感激
检查悬挂点和删除重复点
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2009-4-18 18:55:35 | 显示全部楼层
期待中
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2009-4-19 17:14:57 | 显示全部楼层
也许楼主觉得不言自明,实际上知者甚少
请说明,什么是“悬挂点”“重复点”才好
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 2个

财富等级: 恭喜发财

发表于 2009-4-19 18:55:30 | 显示全部楼层
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2009-4-26 19:31:16 | 显示全部楼层
hsao
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2009-4-27 23:28:39 | 显示全部楼层
(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)

)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-6 05:00 , Processed in 0.450307 second(s), 41 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表