请高人帮我完善这个代码，谢谢！

lucas3 · 发表于 2014-3-10 21:19:41

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

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

×

想删除空白文字同零线，高版本自带清理功能：(command "_.-purge" "_Z" "_.-purge" "_E")但是低版本中没有这个选项，现有一段代码，有高手能帮我完善吗？谢谢！

(setq ss (ssadd)
e (entnext)
)
(while (and e (wcmatch (cdr (assoc 0 (setq en (entget e)))) "LINE,LWPOLYLINE,*TEXT"))
(if (or (and (vlax-property-available-p (setq v (vlax-ename->vla-object e)) 'LENGTH)
(zerop (vla-get-length v))
)
(and (vlax-property-available-p v 'TEXTSTRING) (eq (vla-get-textstring v) ""))
)
(ssadd e ss)
)
(setq e (entnext e))
)
(sssetfirst nil ss)

Free-Lancer · 发表于 2014-3-10 23:10:56

论坛上很多，删超短线、删白点 ....

(defun c:tt (/ i)
(fy:begin)
(setq i 0)
(if (ssget "X" '((0 . "*line,text")))
(mapcar
'(lambda (x / str)
(if (vlax-property-available-p x 'Textstring)
(and (setq str (vlax-get x 'textstring))
(or
(= str "")
(= (vl-string-trim " " str) "")
)
(setq i (1+ i))
(vla-delete x)
)
(and
(equal
(vlax-curve-getdistatparam x (vlax-curve-getendparam x))
0.0
1e-3
)
(setq i (1+ i))
(vla-delete x)
)
)
)
(fy:cset->objs)
)
)
(if (not (zerop i))
(princ (strcat "\nTotle Erased " (itoa i) " Lines & text!"))
)
(fy:end)
(princ)
)

(defun c:tt (/ i) 
  (fy:begin) 
  (setq i 0) 
  (if (ssget "X" '((0 . "*line,text"))) 
    (mapcar 
      '(lambda (x / str) 
         (if (vlax-property-available-p x 'Textstring) 
           (and        (setq str (vlax-get x 'textstring)) 
                (or 
                  (= str "") 
                  (= (vl-string-trim " " str) "") 
                ) 
                (setq i (1+ i)) 
                (vla-delete x) 
           ) 
           (and 
             (equal 
               (vlax-curve-getdistatparam x (vlax-curve-getendparam x)) 
               0.0 
               1e-3 
             ) 
             (setq i (1+ i)) 
             (vla-delete x) 
           ) 
         ) 
       ) 
      (fy:cset->objs) 
    ) 
  ) 
  (if (not (zerop i)) 
    (princ (strcat "\nTotle Erased " (itoa i) " Lines & text!")) 
  ) 
  (fy:end) 
  (princ) 
)

lucas3 · 发表于 2014-3-10 23:17:34

本帖最后由 lucas3 于 2014-3-10 23:20 编辑

Free-Lancer 发表于 2014-3-10 23:10
论坛上很多，删超短线、删白点 ....

大师呀，非得上我用你的函数库呀，测试了一下，多行文字的空白文本无法删除，其实我发的那个选择集只要修改下就行了，还是谢谢你了，更期待有人能帮我完善楼主的代码。

Free-Lancer · 发表于 2014-3-11 07:36:24

lucas3 发表于 2014-3-10 23:17
大师呀，非得上我用你的函数库呀，测试了一下，多行文字的空白文本无法删除，其实我发的那个选择集只要修 ...

只要修改下 ssget 的过滤条件就支持 Mtext

既然不喜欢加载库文件，又不愿意去收集或者自己写那几个函数，独立的 vlx 可以直接使用

lucas3 · 发表于 2014-3-11 11:18:00

帮帮改下楼主的代码可以吗？

st788796 · 发表于 2014-3-11 13:52:05

lucas3 发表于 2014-3-11 11:18
帮帮改下楼主的代码可以吗？

你知道代码哪里有问题吗？
对上面代码理解了多少？

lucas3 · 发表于 2014-3-11 14:03:30

st788796 发表于 2014-3-11 13:52
你知道代码哪里有问题吗？
对上面代码理解了多少？

大师，看了一个关键字，应该是一个选择集，判断长度为0的线以及空白的文字，现在要做的就是删除这结选择集的内容，不知道这样说对不对{:soso_e127:}

st788796 · 发表于 2014-3-11 14:15:37

lucas3 发表于 2014-3-11 14:03
大师，看了一个关键字，应该是一个选择集，判断长度为0的线以及空白的文字，现在要做的就是删除这结选择 ...

楼主这个帖子想用entnext遍历数据库，cad的实体不都在一条道上，有支路的，entnext进了支路就回不到大道的。
正解是遍历选集，如free-lancer方法

lucas3 · 发表于 2014-3-11 16:03:55

st788796 发表于 2014-3-11 14:15
楼主这个帖子想用entnext遍历数据库，cad的实体不都在一条道上，有支路的，entnext进了支路就回不到大道 ...

谢谢大师的解释！

lucas3 · 发表于 2014-3-11 22:07:03

Free-Lancer 发表于 2014-3-11 07:36
只要修改下 ssget 的过滤条件就支持 Mtext

既然不喜欢加载库文件，又不愿意去收集或者自己写那几个函 ...

请教Free-Lancer大侠，以下函数都是起什么作用的呀，不知道怎么找呀

fy:cset->objs,
fy:startundo,
fy:unsetv,
fy:endundo.

st788796 · 发表于 2014-3-11 22:36:37

本帖最后由 st788796 于 2014-3-11 22:38 编辑

lucas3 发表于 2014-3-11 22:07
请教Free-Lancer大侠，以下函数都是起什么作用的呀，不知道怎么找呀
fy:cset->objs,
fy:startund ...

1 应该是把 ssget 获取的选择集转换为Object 列表
2 command undo be 的vla版本，配套的是fy:endundo
3 恢复保存的最初系统变量

没有多高深，不愿用就自己写一遍

lucas3 · 发表于 2014-3-11 23:04:24

st788796 发表于 2014-3-11 22:36
1 应该是把 ssget 获取的选择集转换为Object 列表
2 command undo be 的vla版本，配套的是fy:endundo
...

谢谢大师，晓东有你更精彩！

st788796 · 发表于 2014-3-12 07:42:03

lucas3 发表于 2014-3-11 23:04
谢谢大师，晓东有你更精彩！

遍历Modelspace实体就用
(vlax-for obj (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
(setq typ (vla-get-objectname obj))
(cond
   ((wcmatch typ "*Text")
   ....
   ((wcmatch (strcase typ) "*LINE,ARC,ELLIPSE")
   ....
   )
(t)
)
)

zxq0220 · 发表于 2014-3-12 08:01:37

本帖最后由 zxq0220 于 2014-3-13 08:10 编辑

(defun c:tt ()
(setvar "CMDECHO" 0)
(vl-load-com)
(setq ss (ssget "X" '((0 . "LINE,LWPOLYLINE,*TEXT"))))
(setq i -1)
(repeat (sslength ss)
(setq e (ssname ss (setq i (1+ i))))
(if (or (and (vlax-property-available-p (setq v (vlax-ename->vla-object e)) 'LENGTH)
(zerop (vla-get-length v))
)
(and
(vlax-property-available-p v 'TEXTSTRING)
(eq (vl-string-left-trim " " (vla-get-textstring v)) ""))
)
(entdel e)
)
)
(setvar "CMDECHO" 1)
(princ)
)

st788796 · 发表于 2014-3-12 09:06:57

zxq0220 发表于 2014-3-12 08:01

再说几句，这里曲线类有vlax-curve类函数支持entity的，所以用ssname的话可以不用vlax-ename->vla-object转换，写程序时先评估是否用vla，找到契合点用最佳方法，就是避免这种来回转换方法

账号		自动登录	找回密码
密码			立即注册

[求助] 请高人帮我完善这个代码，谢谢！

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

点评

点评

点评

点评

点评

点评

点评

点评

评分