或者程序是否应该检测到第一个可用的目标标记?这意味着只有当存在“空值”并且需要修复时,程序才会这样做?
顺便问一下:区块名是什么?“A$C3C6630F0”
这是草稿
编辑:这是修改后的代码
(defun c:rvb (/ _AttFunc ss i e values vacant num)
;;; pBe Oct262013 ;;;
(defun _AttFunc(en lst / vals v)
(mapcar (function (lambda (at)
(setq vals (list (vla-get-tagstring at)(vla-get-textstring at)))
(if (and lst (setq v (assoc (car vals) lst)))
(vla-put-textstring at (cadr v))) vals))
(vlax-invoke (if (eq (type en) 'VLA-OBJECT)
en (vlax-ename->vla-object en)) 'Getattributes)
)
)
(defun #tonum (s1 s2 lst) (mapcar '(lambda (s)
(vl-string-translate s1 s2 s)
)
lst
))
(setq atlst '("REV#" "R#DESC" "R#BY" "R#CHK" "R#DATE"))
(if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))))
(if (setq values (vl-remove-if-not
'(lambda (x)
(setq tgnm (car x)) (vl-some
'(lambda (y) (wcmatch tgnm y) ) atlst
))(_AttFunc e nil)
)
)
(progn
(setq vacant nil)
(repeat (setq num 7)
(if (vl-every '(lambda (p) (= (cadr (assoc p values)) "")) (#tonum "#" (itoa num) atlst))
(setq vacant (cons num vacant))
(if vacant
(progn
(_AttFunc e (mapcar '(lambda (t_ fr_)
(list t_ (cadr (assoc fr_ values))))
(#tonum "#" (itoa (last vacant)) atlst)
(#tonum "#" (itoa num) atlst)))
(_AttFunc e(mapcar '(lambda (y)(list y ""))
(#tonum "#" (itoa num)atlst)))
(setq vacant (cons num vacant) vacant (vl-remove (last vacant) vacant)))
)
)
(setq num (1- num))
)
)
)
)
)(princ)
)
编辑:这是修改后的代码
对确切地我们只需将错位标签的值移动到上一版本顶部的第一个空标签。我们永远不需要以编程方式“覆盖”我们的修订信息,尽管我理解其中的困惑。
我们只需要推送放在错误行上的修订信息(通过使用lee mac的全局属性编辑器,我们可以编辑一张图纸上的版本信息,并在需要时将其应用到成百上千张图纸上。唯一的问题是,有时它会像我发布的图像中那样放置修订,因为不是一期中的所有图纸都有相同数量的先前修订。这在旧版本和新版本之间留下了一些空白修订行。)根据图片,我们将其归因于。
希望这能更好地解释这一点,并感谢您的时间和例行吨。
我一做完客户的工作就要测试一下。他们需要在图章和修订栏中更改日期,但不需要新的修订行。是时候启动Lee Mac的全局编辑器并删除它了,然后开始编写代码了。再次非常感谢!
哦,至于街区名称,我不能告诉你。这些块在活动图形中的名称更合适,我认为这一块具有autocad指定的名称,因为我将其从项目目录中删除,并复制到硬盘上。关于它为什么被重命名的最佳猜测。 顺便说一句,令人印象深刻的常规,看起来很复杂。迫不及待地想钻研heh 杰出的
这个例程对我来说效果很好,速度也很快,没有任何警报或不必要的消息!只要把错位的线路撞到正确的位置,做得好,谢谢!!!!
我欠你这个人情 对于值得回复的内容,请查看以下链接:
http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Copy-attribute-from-one-tag-to-another-tag-within-same-block/m-p/4557375#M316266 pBe,这是一个完全不重要的事情,只有当你完全厌倦了,并且有更多的时间,你绝对需要做一些事情,因为我真的觉得很抱歉,在你以如此巨大的方式交付之后,要求更多的东西。
....但我希望你能注释掉你的代码?
根据定义,有很多(lambda)函数很难事先知道它们在做什么。
尽管如此,我要求这样做只是因为我打算从中学习一些东西。。。。嗯,从这里学到了很多!
周末就要开始了,不要着急,如果没有人评论,我也不会抱怨。我真的很感激你能在第一时间解决这个问题。谢谢 以下是我的尝试:
(defun c:fixblk ( / a b i s x )
(if (setq s (ssget "_:L" '((0 . "INSERT") (66 . 1))))
(repeat (setq i (sslength s))
(mapcar
'(lambda ( a b )
(mapcar '(lambda ( a b ) (vla-put-textstring (last a) (caddr b))) a b)
)
(setq a
(vl-sort
(mapcar
'(lambda ( x )
(vl-remove nil
(mapcar
'(lambda ( p )
(vl-some
'(lambda ( a )
(if (wcmatch (cadr a) p) a)
)
x
)
)
'("REV#" "R#DESC" "R#BY" "R#CHK" "R#DATE")
)
)
)
(LM:groupbyfunction
(mapcar
'(lambda ( a )
(list
(vl-list->string
(vl-remove-if-not '(lambda ( x ) (< 47 x 58))
(vl-string->list (vla-get-tagstring a))
)
)
(strcase (vla-get-tagstring a))
(vla-get-textstring a)
(progn (vla-put-textstring a "") a)
)
)
(vl-remove-if-not
'(lambda ( a )
(wcmatch (strcase (vla-get-tagstring a))
"REV#,R#DESC,R#BY,R#CHK,R#DATE"
)
)
(vlax-invoke
(vlax-ename->vla-object (ssname s (setq i (1- i))))
'getattributes
)
)
)
(lambda ( a b ) (= (car a) (car b)))
)
)
'(lambda ( a b ) (> (caar a) (caar b)))
)
)
(vl-remove-if '(lambda ( x ) (vl-every '(lambda ( y ) (= "" (caddr y))) x)) a)
)
)
)
(princ)
)
;; Group By Function-Lee Mac
;; Groups items considered equal by a given predicate function
(defun LM:groupbyfunction ( lst fun / tmp1 tmp2 x1 )
(if (setq x1 (car lst))
(progn
(foreach x2 (cdr lst)
(if (fun x1 x2)
(setq tmp1 (cons x2 tmp1))
(setq tmp2 (cons x2 tmp2))
)
)
(cons (cons x1 (reverse tmp1)) (LM:groupbyfunction (reverse tmp2) fun))
)
)
)
(vl-load-com) (princ)
快速演示:
不客气,很高兴我能帮上忙
我稍后再谈,伙计,我会修改代码以匹配LMs帖子
非常好的LM。 干杯,帕特里克!
更新邮政编码#11
附件是代码的“注释”版本。
玩得开心,如果你有任何问题,喊出来
拆下真空箱。LSP
页:
1
[2]