用s旋转所有属性
2009年7月28日以下是完整的修订代码。
此代码将提示输入旋转角度。
代码也有错误捕捉。
要将此程序用于您自己的区块
属性指以红色突出显示的代码部分。
您可以在代码中的此处更改属性标记
与您自己的属性标记一起使用。
请参阅下面的附加Line_扩展。测试程序的图纸。
此代码的函数语法：AVR
Line_扩展。图纸
AVR。拉链
无论如何，谢谢你，我知道了！
(defun C:TVR ()
(setq BNAM "8-WAY")
(setq BLOCROT (ssget "x" (list (cons 0 "INSERT")(cons 2 BNAM)(cons 66 1))))
(if
(/= BLOCROT nil)
(progn
(setq INDEX 0)
(repeat
(sslength BLOCROT)
(setq ENAME (ssname BLOCROT INDEX))
(setq ELIST (entget ENAME))
(while
(/= (cdr (assoc 0 ELIST)) "SEQEND")
(setq ELIST (entget ENAME))
(if
(= "TAP-VAL" (cdr (assoc 2 ELIST)))
(progn
(entmod
(subst
(cons 50 0.0)
(assoc 50 ELIST) ELIST
)
)
(entupd ENAME)
)
)
(setq ENAME (entnext ENAME))
)
(setq INDEX (1+ INDEX))
)
)
(ALERT (strcat "\nThe block "BNAM" was not found."))
)
(princ)
) 哇！我写了一些东西来做你想做的事情，有趣的是，我现在正在使用它
不确定这是否完全解决了问题，但这是我的函数：
(defun c:cr( / ss obj)
(vl-load-com)
(if (ssget "X" (list (cons 2 "IDI-SECU-CAMR")))
(progn
(vlax-for obj (setq ss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
(if (= (vla-get-HasAttributes obj) :vlax-true)
(foreach attVar (vlax-invoke obj 'GetAttributes)
(if (not (= (vla-get-TagString attVar) "NUM"))
(vla-put-Rotation attVar 0)))))
(vla-delete ss)))
(princ)
)
非常简单：获取具有特定名称的所有块，然后遍历块的每个属性，看看哪个属性标记为“NUM”，并将旋转设置为0（vla put旋转部分）。我写这篇文章是因为我有很多具有各种旋转的块，我想把所有这些块的属性放回0度旋转，以便于可读性。
希望能有所帮助。^。^
谢谢你，
但在上一篇帖子中，我在最后一分钟才弄明白。我很欣赏代码，但我只是在寻找一些方向。我只需要让代码正常工作。我想学习这些东西，而不是依赖别人为我做。相信我，当我告诉你的努力和代码是非常感谢。我知道我很快就想出来了，但你只是在那些时候，你的大脑似乎被洗掉了。
谢谢
秃鹰 另一种快速方法：
;; ============[ AttRot.lsp ]===============
;;
;;FUNCTION:
;;Will move Multiple Attribute Tags
;;
;;SYNTAX: ATTROT
;;
;;AUTHOR:
;;Copyright (c) 2009, Lee McDonnell
;;(Contact Lee Mac, CADTutor.net)
;;
;;VERSION:
;;1.0~02.07.2009
;;
;; =========================================
(defun c:AttRot (/ *error* lklst ent Blk
Obj bNme ss bPt ObjLst
iPt gr dat cAng)
(vl-load-com)
(defun *error* (msg)
(vla-EndUndoMark
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(if lklst
(foreach l lklst
(vla-put-lock
(car l) (cdr l))))
(if (not
(wcmatch
(strcase msg)
"*BREAK,*CANCEL*,*EXIT*"))
(princ
(strcat "\n<< Error: " msg " >>")))
(redraw)
(princ))
(vlax-for l
(vla-get-layers
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(setq lklst
(cons
(cons l
(vla-get-lock l)) lklst))
(vla-put-lock l :vlax-false))
(while
(progn
(setq ent
(car (nentsel "\nSelect Attribute: ")))
(cond
((eq 'ENAME (type ent))
(if
(not
(eq "ATTRIB"
(cdr (assoc 0 (entget ent)))))
(princ "\n** Object is not an Attribute **")
nil))
(t (princ "\n** Nothing Selected **")))))
(setq Blk
(vla-ObjectIdtoObject
(vla-get-ActiveDocument
(vlax-get-acad-object))
(vla-get-OwnerId
(setq Obj
(vlax-ename->vla-object ent)))))
(setq bNme
(if (vlax-property-available-p Blk 'EffectiveName)
(vla-get-EffectiveName Blk)
(vla-get-Name Blk)))
(setq ss
(ssget "_X" (list (cons 0 "INSERT")
(cons 2 bNme)
(cons 66 1))))
(vla-StartUndoMark
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(setq ObjLst
(vl-remove-if-not
(function
(lambda (x)
(eq (vla-get-TagString x)
(vla-get-TagString Obj))))
(apply 'append
(mapcar 'asmi-GetAttributes
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex ss)))))))
(setq iPt
(vlax-safearray->list
(vlax-variant-value
(vla-get-TextAlignmentPoint Obj))))
(while
(progn
(setq gr (grread t 15 0) dat (cadr gr))
(cond
((and (eq 5 (car gr)) (listp dat))
(redraw)
(setq cAng
(angle
(vlax-safearray->list
(vlax-variant-value
(vla-get-TextAlignmentPoint Obj))) dat))
(mapcar
(function
(lambda (x)
(vla-put-rotation x cAng))) ObjLst)
(grvecs (list -6 iPt dat)) t) ; Keep in Loop
((or (eq 25 (car gr)) ; Right Click
(eq 3 (car gr)) ; Left Click
(and
(eq 2 (car gr))
(vl-position dat '(13 32)))) ; Enter Space
nil) ; Exit Loop
)))
(vla-EndUndoMark
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(foreach l lklst
(vla-put-lock
(car l) (cdr l)))
(redraw)
(princ))
;; ASMI
(defun asmi-GetAttributes (Block / atArr caArr)
(append
(if
(not
(vl-catch-all-error-p
(setq atArr
(vl-catch-all-apply
'vlax-safearray->list
(list
(vlax-variant-value
(vla-GetAttributes Block)))))))
atArr)
(if
(not
(vl-catch-all-error-p
(setq caArr
(vl-catch-all-apply
'vlax-safearray->list
(list
(vlax-variant-value
(vla-GetConstantAttributes Block)))))))
caArr)))
谢谢李，
我的大脑在最后一分钟开始跳动。见帖子2。
非常感谢，但正如你们所知，我不希望代码为我完成。我需要独立解决这个问题。在右边指我
方向就足够了。
非常感谢。
秃鹰
好的，但只是踢-这一个将让你进入角度也
;; ============[ AttRot.lsp ]===============
;;
;;FUNCTION:
;;Will move Multiple Attribute Tags
;;
;;SYNTAX: ATTROT
;;
;;AUTHOR:
;;Copyright (c) 2009, Lee McDonnell
;;(Contact Lee Mac, CADTutor.net)
;;
;;VERSION:
;;1.0~02.07.2009
;;2.0~02.07.2009
;;
;; =========================================
(defun c:AttRot (/ *error* lklst ent Blk
Obj bNme ss bPt ObjLst
iPt gr dat cAng vl ov str)
(vl-load-com)
(defun *error* (msg)
(vla-EndUndoMark
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(if ov (mapcar 'setvar vl ov))
(if lklst
(foreach l lklst
(vla-put-lock
(car l) (cdr l))))
(if (not
(wcmatch
(strcase msg)
"*BREAK,*CANCEL*,*EXIT*"))
(princ
(strcat "\n<< Error: " msg " >>")))
(redraw)
(princ))
(setq vl '("MODEMACRO")
ov (mapcar 'getvar vl))
(vlax-for l
(vla-get-layers
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(setq lklst
(cons
(cons l
(vla-get-lock l)) lklst))
(vla-put-lock l :vlax-false))
(while
(progn
(setq ent
(car (nentsel "\nSelect Attribute: ")))
(cond
((eq 'ENAME (type ent))
(if
(not
(eq "ATTRIB"
(cdr (assoc 0 (entget ent)))))
(princ "\n** Object is not an Attribute **")
nil))
(t (princ "\n** Nothing Selected **")))))
(setq Blk
(vla-ObjectIdtoObject
(vla-get-ActiveDocument
(vlax-get-acad-object))
(vla-get-OwnerId
(setq Obj
(vlax-ename->vla-object ent)))))
(setq bNme
(if (vlax-property-available-p Blk 'EffectiveName)
(vla-get-EffectiveName Blk)
(vla-get-Name Blk)))
(setq ss
(ssget "_X" (list (cons 0 "INSERT")
(cons 2 bNme)
(cons 66 1))))
(vla-StartUndoMark
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(setq ObjLst
(vl-remove-if-not
(function
(lambda (x)
(eq (vla-get-TagString x)
(vla-get-TagString Obj))))
(apply 'append
(mapcar 'asmi-GetAttributes
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex ss)))))))
(setq iPt
(vlax-safearray->list
(vlax-variant-value
(vla-get-TextAlignmentPoint Obj))) str "")
(while
(progn
(setq gr (grread t 15 0) dat (cadr gr))
(setvar "MODEMACRO"
(strcat "Rotation: "
(rtos (rtd (vla-get-Rotation Obj)) 2 2) (chr 186)))
(cond
((and (eq 5 (car gr)) (listp dat))
(redraw)
(setq cAng
(angle
(vlax-safearray->list
(vlax-variant-value
(vla-get-TextAlignmentPoint Obj))) dat))
(mapcar
(function
(lambda (x)
(vla-put-rotation x cAng))) ObjLst)
(grvecs (list -6 iPt dat)) t) ; Keep in Loop
((eq 2 (car gr))
(cond ((or (eq 46 dat) (<= 48 dat 57)) ; numbers or dp.
(princ (chr dat))
(setq str (strcat str (chr dat))))
((eq 8 dat) ; BackSpace
(princ (strcat (chr(chr 32) (chr ))
(setq str (substr str 1 (1- (strlen str)))))
((vl-position dat '(32 13)) ; Enter Space
(if (setq cAng (distof str))
(not ; Exit Loop
(mapcar
(function
(lambda (x)
(vla-put-rotation x (dtr cAng)))) Objlst))
nil)) ; Exit Loop
(t t))) ; Keep in Loop
((or (eq 25 (car gr)) ; Right Click
(eq 3 (car gr))) ; Left Click
nil) ; Exit Loop
(t t)))) ; Keep in Loop
(vla-EndUndoMark
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(foreach l lklst
(vla-put-lock
(car l) (cdr l)))
(mapcar 'setvar vl ov)
(redraw)
(princ))
(defun rtd (x)
(* 180. (/ x pi)))
(defun dtr (x)
(* pi (/ x 180.)))
;; ASMI
(defun asmi-GetAttributes (Block / atArr caArr)
(append
(if
(not
(vl-catch-all-error-p
(setq atArr
(vl-catch-all-apply
'vlax-safearray->list
(list
(vlax-variant-value
(vla-GetAttributes Block)))))))
atArr)
(if
(not
(vl-catch-all-error-p
(setq caArr
(vl-catch-all-apply
'vlax-safearray->list
(list
(vlax-variant-value
(vla-GetConstantAttributes Block)))))))
caArr)))
这很新颖，但我只需要将角度设置为零，无论块的角度是什么。稍后我可能会以几种不同的方式使用此例程。至于现在，我很高兴我自己通过了这一关。我可能会将其添加到我喜欢创建的那些块库程序中。
我会及时到达VL，但只有在我先掌握香草之后。
谢谢
我完全理解，这启发了我创建某种属性套件。。。也许以后再来
听起来很棒。我不得不注意到，属性操作和值编辑是经常提到的非常流行的任务。我相信你会得到很多点击这些节目，因为他们总是在需求。
期待着，李，
谢谢
秃鹰
页:
[1]
2