俩个函数合在一起，求帮助

fkyourmather · 发表于 2013-5-20 16:57:02

Free-Lancer 发表于 2013-5-20 15:22
过滤表中去掉 -4 部分

我看得大部分只是有部分疑问的(vl-catch-all-apply
(function
(lambda
可是语法是这样(vl-catch-all-apply 'function list) 我晕了

Free-Lancer · 发表于 2013-5-20 18:31:24

先看看 vl-catch-all-apply 的help，这和错误处理机制有关来自: Android客户端

fkyourmather · 发表于 2013-5-20 20:21:55

Free-Lancer 发表于 2013-5-20 13:01
通俗讲对abc内每个元素用 lambda 内语句进行一系列处理后，用返回值替换原值

要是把结果这样整合怎么弄text2 (strcat "总长度为: " (rtos totlength 2 4) "单位")
)
(if (setq insertpt (getpoint "\n请输入文字插入点: "))
(if (setq height (getdist "\n请输入文字高度:"))
(setq insertp1 (vlax-3d-point insertpt)
insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height)))
textobj1 (vla-addtext modelspace text1 insertp1 height)

fkyourmather · 发表于 2013-6-1 22:57:30

Free-Lancer 发表于 2013-5-20 11:57

有个疑问～请教～如果我要把图层1 2 3的长度分别统计如何处理

Free-Lancer · 发表于 2013-6-1 23:33:58

fkyourmather 发表于 2013-6-1 22:57
有个疑问～请教～如果我要把图层1 2 3的长度分别统计如何处理

你把统计一个图层的写成函数形式，参数用实体列表，返回值为总长度
在 Ssget 后，将 1 2 3 图层实体分别形成实体列表后，用上面的函数计算

Free-Lancer · 发表于 2013-6-2 00:47:04

本帖最后由 Free-Lancer 于 2013-6-2 01:16 编辑

分层统计,这种程序根据自己需要随时写了

游客，本帖隐藏的内容需要积分高于 50 才可浏览，您当前积分为 0

fkyourmather · 发表于 2013-6-3 08:37:57

Free-Lancer 发表于 2013-6-2 00:47
分层统计,这种程序根据自己需要随时写了**** 本内容被作者隐藏 ****

lancer大师总是出人意料，如果有更好的想法，希望能得到您的帮助

fkyourmather · 发表于 2013-7-1 13:48:26

Free-Lancer 发表于 2013-6-2 00:47
分层统计,这种程序根据自己需要随时写了**** 本内容被作者隐藏 ****

如果按颜色的话，修改下，如何处理呢！

Free-Lancer · 发表于 2013-7-1 16:01:33

fkyourmather 发表于 2013-7-1 13:48
如果按颜色的话，修改下，如何处理呢！

要学会灵活运用

(defun lyrlen (el)
(apply '+
(mapcar
'(lambda (e)
(vlax-curve-getdistatparam e (vlax-curve-getendparam e))
)
el
)
)
)
;;分层统计先长度
(defun c:tt (/ ss l1 col)
(if (setq ss (ssget '((0 . "*line,arc,circle,ellipse")))) ;_(8 . "1,2,3")))可以根据需要增加图层过滤
(vl-catch-all-apply
'(lambda (/ sl i e el lyr n ll tl col lyrc)
(setq sl (sslength ss)
i -1
)
(repeat sl
(setq e (ssname ss (setq i (1+ i)))
el (entget e)
lyr (cdr (assoc 8 el))
col (cdr (assoc 62 el))
)
(cond
((= col 0) ;_byblock
(setq n "Fy7"
lyrc 7
)
)
((= col nil) ;_bylayer
(setq n
(strcat
"Fy"
(itoa
(setq lyrc (cdr (assoc 62 (tblsearch "layer" lyr))))
)
)
)
)
(t
(setq n (strcat "Fy" (itoa col))
lyrc col
)
)
)
(set (read n) (cons e (eval (read n))))
(if (vl-position n l1)
nil
(setq l1 (cons n l1)
ll (cons lyrc ll)
)
)
)
(setq tl (mapcar '(lambda (x) (lyrlen (eval (read x)))) l1))
(if
(setq p (getpoint "\nOutput Insertpoint<Enter to princ>: "))
(mapcar '(lambda (x y)
(entmake (list '(0 . "Text")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 1
(strcat "Color "
(itoa y)
" Totle Length = "
(rtos x 2 3)
)
)
(cons 40 (getvar "textsize"))
(cons 10 p)
(cons 62 y)
)
)
(setq
p (mapcar '+
p
(mapcar '*
'(0. -1.5 0.)
(list (getvar "textsize")
(getvar "textsize")
0.
)
)
)
)
)
tl
ll
)
(mapcar '(lambda (x y)
(princ (strcat "\nColor "
(itoa y)
" Totle lenght = "
(vl-princ-to-string x)
)
)
)
tl
ll
)
)
)
)
)
(if l1
(mapcar '(lambda (x) (set (read x) nil)) l1)
)
(princ)
)

(defun lyrlen (el) 
  (apply '+ 
  (mapcar 
    '(lambda (e) 
       (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) 
     ) 
    el 
  ) 
  ) 
) 
;;分层统计先长度 
(defun c:tt (/ ss l1 col) 
  (if (setq ss (ssget '((0 . "*line,arc,circle,ellipse")))) ;_(8 . "1,2,3")))可以根据需要增加图层过滤 
    (vl-catch-all-apply 
      '(lambda (/ sl i e el lyr n ll tl col lyrc) 
  (setq sl (sslength ss) 
        i  -1 
  ) 
  (repeat sl 
    (setq e   (ssname ss (setq i (1+ i))) 
   el  (entget e) 
   lyr (cdr (assoc 8 el)) 
   col (cdr (assoc 62 el)) 
    ) 
    (cond 
      ((= col 0) ;_byblock 
       (setq n "Fy7" 
      lyrc 7 
       ) 
      ) 
      ((= col nil) ;_bylayer 
       (setq n 
       (strcat 
         "Fy" 
         (itoa 
    (setq lyrc (cdr (assoc 62 (tblsearch "layer" lyr)))) 
         ) 
       ) 
       ) 
      ) 
      (t 
       (setq n  (strcat "Fy" (itoa col)) 
      lyrc col 
       ) 
      ) 
    ) 
    (set (read n) (cons e (eval (read n)))) 
    (if (vl-position n l1) 
      nil 
      (setq l1 (cons n l1) 
     ll (cons lyrc ll) 
      ) 
    ) 
  ) 
  (setq tl (mapcar '(lambda (x) (lyrlen (eval (read x)))) l1)) 
  (if 
    (setq p (getpoint "\nOutput Insertpoint<Enter to princ>: ")) 
     (mapcar '(lambda (x y) 
         (entmake (list '(0 . "Text") 
          '(100 . "AcDbEntity") 
          '(100 . "AcDbText") 
          (cons 1 
         (strcat "Color " 
          (itoa y) 
          " Totle Length = " 
          (rtos x 2 3) 
         ) 
          ) 
          (cons 40 (getvar "textsize")) 
          (cons 10 p) 
          (cons 62 y) 
    ) 
         ) 
         (setq 
    p (mapcar '+ 
       p 
       (mapcar '* 
        '(0. -1.5 0.) 
        (list (getvar "textsize") 
       (getvar "textsize") 
       0. 
        ) 
       ) 
      ) 
         ) 
       ) 
      tl 
      ll 
     ) 
     (mapcar '(lambda (x y) 
         (princ (strcat "\nColor " 
          (itoa y) 
          " Totle lenght = " 
          (vl-princ-to-string x) 
         ) 
         ) 
       ) 
      tl 
      ll 
     ) 
  ) 
       ) 
    ) 
  ) 
  (if l1 
    (mapcar '(lambda (x) (set (read x) nil)) l1) 
  ) 
  (princ) 
)

fkyourmather · 发表于 2013-7-1 18:58:09

Free-Lancer 发表于 2013-7-1 16:01
要学会灵活运用

嗯 ssget(if (setq ss (ssget '((430 . color"))))
然后按颜色输出，你要告诉我啊，这个我真得不是很会啊

st788796 · 发表于 2013-7-1 21:50:24

fkyourmather 发表于 2013-7-1 18:58
嗯 ssget(if (setq ss (ssget '((430 . color"))))
然后按颜色输出，你要告诉我啊，这个我真得不是很会 ...

颜色的组码是 62 ，高版本增加了真彩色，DXF中是 430，但 INDEX COLOR 是 0 - 256，0 是 Byblock，对Bylayer曲线，不管是 Index 色还是 Truecolor 在DXF 表中是没有 62 和 430 的，也就是 ssget 不能过滤这个颜色的，所以这个颜色统计除非曲线是定义了独立颜色，否则就按框选范围统计全部颜色

fkyourmather · 发表于 2013-7-1 23:41:33

统计全部颜色？代码

st788796 · 发表于 2013-7-2 06:27:17

fkyourmather 发表于 2013-7-1 23:41
统计全部颜色？代码

框选范围内的全部颜色

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

[求助] 俩个函数合在一起，求帮助

点评

点评

点评

点评

点评

点评