相同线长成功了

amwkto2011 · 发表于 2014-11-29 16:33:17

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

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

×

本帖最后由 amwkto2011 于 2014-11-29 18:08 编辑

(defun c:tcc(/ sel get0 obj rt len ss gth n add name obj2 len2 )
(princ "\n功能 [选择相同线长]")
(setq sel (car (entsel "\n点取参照对象:"))
get0 (assoc 0 (entget sel)))
(setq obj (vlax-ename->vla-object sel))
(setq rt (rtos (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))2 2))
(prompt (strcat "\n参照对象长度<" rt "> 过滤容差<0.3>"))
(setq len (atof rt ))
(setq ss (ssget (list get0)))
(setq gth (sslength ss)
n 0)
(setq add (ssadd))
(repeat gth
(setq name (ssname ss n))
(setq obj2 (vlax-ename->vla-object name))
(setq len2 (atof (rtos (vlax-curve-getdistatparam obj2 (vlax-curve-getendparam obj2))2 2)))
(if (equal len len2 0.3) (ssadd name add))
(setq n (1+ n))
);while
(if add (sssetfirst nil add))
(princ)
)

感谢st788796指点，相同线长弄出来了，需要的拿去用吧
也希望指点不足的，我再学习下，谢谢哦

炫翔 · 发表于 2014-11-29 16:44:42

:)vlax-curve... 函数不需要转VLA

炫翔 · 发表于 2014-11-29 16:46:26

(defun c:tcc ( / add get0 gth len len2 n name obj obj2 rt sel ss)
(princ "\n功能 [选择相同线长]")
(setq obj (car (entsel "\n点取参照对象:"))
get0 (assoc 0 (entget sel))
)
(setq rt (rtos (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) 2 2))
(prompt (strcat "\n参照对象长度<" rt "> 过滤容差<0.3>"))
(setq len (atof rt))
(setq ss (ssget (list get0)))
(setq gth (sslength ss)
n 0
)
(setq add (ssadd))
(repeat gth
(setq obj2 (ssname ss n))
(setq len2 (atof (rtos (vlax-curve-getdistatparam obj2 (vlax-curve-getendparam obj2)) 2 2)))
(if (equal len len2 0.3)
(ssadd name add)
)
(setq n (1+ n))
);while
(if add
(sssetfirst nil add)
)
(princ)
)

XDSoft · 发表于 2014-11-29 17:00:15

做个动画就更完美了。

amwkto2011 · 发表于 2014-11-29 17:27:13

XDSoft 发表于 2014-11-29 17:00
做个动画就更完美了。

好的，等下弄个动画

amwkto2011 · 发表于 2014-11-29 17:27:48

炫翔发表于 2014-11-29 16:46

感谢，炫哥指导

st788796 · 发表于 2014-11-29 18:18:04

本帖最后由 st788796 于 2014-11-29 18:19 编辑

可以这样写

(defun c:tcc (/ obj get0 rt len ss sl el e add s)
(princ "\n功能 [选择相同线长]")
(if (and (progn
(princ "\n点取参照对象...")
(setq s (ssget ":S" '((0 . "*Line,arc,circle,ellipse"))))
(setq obj (ssname s 0))
)
(setq get0 (assoc 0 (entget obj)))
(setq rt
(rtos
(vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))
2
2
)
)
(progn
(prompt (strcat "\n参照对象长度<" rt "> 过滤容差<0.3>"))
(setq len (atof rt))
(setq ss (ssget (list get0)))
)
)
(progn
(setq sl (sslength ss))
(while (setq e (ssname ss (setq sl (1- sl))))
(setq el (cons e el))
)
(if (setq el (vl-remove-if-not
'(lambda (x)
(equal (vlax-curve-getdistatparam
x
(vlax-curve-getendparam x)
)
len
0.3
)
)
el
)
)
(progn
(setq add (ssadd))
(foreach x el (ssadd x add))
(sssetfirst nil add)
)
)
)
)
(princ)
)

(defun c:tcc (/ obj get0 rt len ss sl el e add s) 
  (princ "\n功能 [选择相同线长]") 
  (if (and (progn 
             (princ "\n点取参照对象...") 
             (setq s (ssget ":S" '((0 . "*Line,arc,circle,ellipse")))) 
             (setq obj (ssname s 0)) 
           ) 
           (setq get0 (assoc 0 (entget obj))) 
           (setq rt 
                  (rtos 
                    (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) 
                    2 
                    2 
                  ) 
           ) 
           (progn 
             (prompt (strcat "\n参照对象长度<" rt "> 过滤容差<0.3>")) 
             (setq len (atof rt)) 
             (setq ss (ssget (list get0))) 
           ) 
      ) 
    (progn 
      (setq sl (sslength ss)) 
      (while (setq e (ssname ss (setq sl (1- sl)))) 
        (setq el (cons e el)) 
      ) 
      (if (setq        el (vl-remove-if-not 
                     '(lambda (x) 
                        (equal (vlax-curve-getdistatparam 
                                 x 
                                 (vlax-curve-getendparam x) 
                               ) 
                               len 
                               0.3 
                        ) 
                      ) 
                     el 
                   ) 
          ) 
        (progn 
          (setq add (ssadd)) 
          (foreach x el (ssadd x add)) 
          (sssetfirst nil add) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

newer · 发表于 2014-11-29 19:44:38

本帖最后由 newer 于 2014-11-29 19:46 编辑

用API写，就是这样

(defun c:tt()
(if (and (setq fuzz (getreal "\n容差<退出>:"))
(setq e (car (xdrx_entsel "\n样本实体<退出>:" '((0 . "*line,arc,ellipse,circle")))))
(progn
(prompt "\n选取实体<退出>:")
(setq ss (ssget '((0 . "*line,arc,ellipse,circle"))))
)
)
(progn
(setq len (xdrx_getpropertyvalue e "length"))
(setq lst (mapcar '(lambda(x)(list (xdrx_getpropertyvalue x "length") x))(xdrx_pickset->ents ss))
lst1 (xd::list:groupbyindex lst fuzz)
)
(sssetfirst nil (XD::Entity->Pickset(cdar (vl-member-if '(lambda (x)(equal (car x) len fuzz)) lst1))))
)
)
(princ)
)

newer · 发表于 2014-11-29 19:52:27

再简化些：

(defun c:tt()
(if (and (setq fuzz (getreal "\n容差<退出>:"))
(setq e (car (xdrx_entsel "\n样本实体<退出>:" '((0 . "*line,arc,ellipse,circle")))))
(progn
(prompt "\n选取实体<退出>:")
(setq ss (ssget '((0 . "*line,arc,ellipse,circle"))))
)
)
(progn
(setq len (xdrx_getpropertyvalue e "length"))
(setq ss1 (ssadd))
(mapcar '(lambda(x)(if (equal len (xdrx_getpropertyvalue x "length") fuzz)(ssadd x ss1)))(xdrx_pickset->ents ss))
(sssetfirst nil ss1)
)
)
(princ)
)

Free-Lancer · 发表于 2014-11-30 10:02:06

本帖最后由 Free-Lancer 于 2014-11-30 10:03 编辑

newer 发表于 2014-11-29 19:52
再简化些：

还有一种直接操作选择集方法

(defun c:tt (/ _Curve:Length s e filter len i e1 ss fuzz)
(defun _Curve:Length (curve /)
(vlax-curve-getdistatparam
curve
(vlax-curve-getendparam curve)
)
)
(if (and (setq fuzz (getreal "\nInput tolerance: "))
(progn
(prompt "\nPick Curve...")
(setq s (ssget ":S" '((0 . "*Line,arc,circle,ellipse"))))
)
(setq e (ssname s 0))
(setq filter (assoc 0 (entget e)))
(progn
(prompt "\nSelect Curves ...")
(setq ss (ssget (list filter)))
)
)
(progn
(setq len (_Curve:Length e)
i -1
)
(while (/= i (- (sslength ss) 2))
(if
(not
(equal len
(_Curve:Length (setq e1 (ssname ss (setq i (1+ i)))))
0.3
)
)
(progn
(ssdel e1 ss);_删除实体后，选集内后面实体计数前移
(setq i (1- i));_计数器要回退
)
)
)
(if ss
(sssetfirst nil ss)
)
)
)
(princ)
)

(defun c:tt (/ _Curve:Length s e filter len i e1 ss fuzz) 
  (defun _Curve:Length (curve /) 
    (vlax-curve-getdistatparam 
      curve 
      (vlax-curve-getendparam curve) 
    ) 
  ) 
  (if (and (setq fuzz (getreal "\nInput tolerance: ")) 
           (progn 
             (prompt "\nPick Curve...") 
             (setq s (ssget ":S" '((0 . "*Line,arc,circle,ellipse")))) 
           ) 
           (setq e (ssname s 0)) 
           (setq filter (assoc 0 (entget e))) 
           (progn 
             (prompt "\nSelect Curves ...") 
             (setq ss (ssget (list filter))) 
           ) 
      ) 
    (progn 
      (setq len        (_Curve:Length e) 
            i        -1 
      ) 
      (while (/= i (- (sslength ss) 2)) 
        (if 
          (not 
            (equal len 
                   (_Curve:Length (setq e1 (ssname ss (setq i (1+ i))))) 
                   0.3 
            ) 
          ) 
           (progn 
             (ssdel e1 ss);_删除实体后，选集内后面实体计数前移 
             (setq i (1- i));_计数器要回退 
           ) 
        ) 
      ) 
      (if ss 
        (sssetfirst nil ss) 
      ) 
    ) 
  ) 
  (princ) 
)

amwkto2011 · 发表于 2014-11-30 10:58:53

st788796 发表于 2014-11-29 18:18
可以这样写

'(lambda (x) 这是什么意思，看帮助看不懂它的用法
举个简单的例子给我看下，它的用法

amwkto2011 · 发表于 2014-11-30 11:04:15

Free-Lancer 发表于 2014-11-30 10:02
还有一种直接操作选择集方法

学习了，感谢指导有点看不懂这个了，要慢慢消化下，有点高深了

amwkto2011 · 发表于 2014-11-30 11:06:31

newer 发表于 2014-11-29 19:52
再简化些：

(mapcar '(lambda(x) 看不懂这个，帮助也一下理解不了，能给讲解下不，谢谢了

XDSoft · 发表于 2014-11-30 11:40:57

amwkto2011 发表于 2014-11-30 11:06
(mapcar '(lambda(x) 看不懂这个，帮助也一下理解不了，能给讲解下不，谢谢了

(mapcar '(lambda(x) .....) lst)

lst 是表，把表LST的每一个元素作为lambda的参数X，进入到lambda求值，结果是每个求值结果组成的表。

比如： lst = '(1 2 3 4 5)

(mapcar '(lambda(x) (1+ x)) lst) ===> （2 3 4 5 6）

相当于：
(foreach n lst
(setq lst1 (cons (1+ n) lst1))
)
(reverse lst1)

你理解 (lambda(x) (1+ x)) lst) 的 lambda相当于一个没有名字的临时函数。

amwkto2011 · 发表于 2014-11-30 11:44:04

XDSoft 发表于 2014-11-30 11:40
(mapcar '(lambda(x) .....) lst)

lst 是表，把表LST的每一个元素作为lambda的参数X，进入到lambda求 ...

谢谢老大，有点感觉了，写程序来试下去

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

[原创] 相同线长成功了

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

评分

点评

点评

点评

点评

点评

点评

点评

点评