单Att旋转
你好我有一个lisp，可以旋转选定块的属性。是否可以更改为只有选定属性旋转，而不是所有属性旋转。
一个块中有多个属性，它们都需要不同的角度。
(defun c:atrot(/ blSet attLst errCount oldAng)
(if(not atrot:rAng)(setq atrot:rAng 0))
(setq oldAng atrot:rAng
atrot:rAng
(getangle
(strcat "\nSpecify rotation angle <"(angtos atrot:rAng)">: ")))
(if(not atrot:rAng)(setq atrot:rAng oldAng))
(princ "<<< Select blocks to rotate attributes >>>")
(setq errCount 0)
(if
(setq blSet(ssget '((0 . "INSERT")(66 . 1))))
(progn
(setq blSet(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex blSet)))))
(foreach itm blSet
(setq attLst
(vlax-safearray->list
(vlax-variant-value
(vla-GetAttributes itm))))
(foreach att attLst
(if(vl-catch-all-error-p
(vl-catch-all-apply
'vla-put-Rotation(list att atrot:rAng)))
(setq errCount(1+ ErrCount))
); end if
); end foreach
); end foreach
); end progn
(princ ">>> Nothing selected! <<<")
); end if
(if(/= 0 errCount)
(princ
(strcat "\n>>> "
(itoa errCount)
" attributes or blocks were on locked layer! <<< "))
); end if
(princ)
); end of c:atrot
还是谢谢你的时间
PMXcad 这篇文章可能有一些有用的东西http://www.cadtutor.net/forum/showthread.php?97667-自动将文本旋转到任何UCS Good job alm865. Almost perfect.
Can it be made simpler?ATROT -> angle -> pick attribute -> done.
And for the other attributes i wil do the same....running ATROT.
There are blocks with a lot of attributtes, like 10. And it could be that a attribute is the last one. By selecting a attribute for rotating.i scip the other attributes.
PMXcad Well there's lots of ways to do it.
If it was me I'd do a first pass with your script and create a list of attributes. Send the list to a 'list box in a dialog' for user selection (i.e. create a DCL file). The user returns the list and you check that each item is a member of the user's selection. Kind of like how the new 'laydel' command works if you choose selection by name.
If I get some time I'll post an example unless someone beats me to it with a better way ;-) Okay Alm865, it's solved. I found a lisp in my lisp database. This does exactly what I want and more.
See code:
;*Variables ans = given answer to what to change *;* tmp = temporary storage *;* alist = storage of separate selections (check list) *;* pt = storage for point selections *;* sset= selection set storage ( check for entity ) *;* cnt = storage for counter vs. string length *;*************************************************************************; (defun c:chatt ( / cnt ans tmp alist pt sset value angle style layer color hgt pos) (setq ans "") (setq tmp " ") (setq alist (list "")) (While (/= tmp "") ; Continue if user ; gives us an answer. (prompt "\nChange what?\nValue, Angle,") (prompt " Style, Layer, Color, Height, Position:"); Long eh? (if (> (strlen ans) 0) (progn (prompt "\nCurrent[") ; Display the current (prompt ans) ; list if available. (prompt "]:") ) ) (setq tmp (strcase (substr (getstring) 1 1))) (if (AND (or (= tmp "V")(= tmp "A")(= tmp "S")(= tmp "L") (= tmp "C")(= tmp "H")(= tmp "P")) (= nil (member tmp alist)) ) ; If the answer is in the (progn ; group and not in the (setq ans(strcat ans tmp)) ; check list add it! (setq alist (append alist (list tmp))) ) ) ) (if (= ans "")(setq ans "VASLCHP")) ; If the user doesn't (setq cnt 1) ; us an option force (setq value nil) ; all of them! (setq angle nil) (setq style nil) ; Set all the variables (setq layer nil) ; to nil! (setq color nil) ; I'm not very trusting! (setq hgt nil) (setq pos nil) (While (/= "" (setq tmp (substr ans cnt 1))) ; Check for options and ; get the values. (if (= tmp "V") (setq value (getstring "\nNew Value for attributes: ")) ) (if (= tmp "A") (setq angle (* 180 (/ (getangle "\nNew angle for attributes: ") pi))) ) (if (= tmp "S") (setq style (getstring "\nNew style for attributes: ")) ) (if (= tmp "L") (setq layer (getstring "\nNew layer for attributes: ")) ) (if (= tmp "C") (setq color (getstring "\nNew color for attributes: ")) ) (if (= tmp "H") (setq hgt (getdist "\nNew height for attributes: ")) ) (if (= tmp "P")(setq pos 1)) (setq cnt (+ cnt 1)) ) (setvar "cmdecho" 0) (setq pt (getpoint "\nSelect Attribute: ")); As long as we get a (while pt ; point value! (if(setq sset (ssget pt)) ; Check for an entity! (progn (if (= nil (assoc 66 (entget (ssname sset 0)))) (progn ; If it does not have ; Attributes worry! (prompt "\nNot An Attributed Block") (setq sset nil) ) ) ) (progn ; If you dont find (prompt "\nNo Entity Found") ; an entity at the (setq sset nil) ; given location ) ; worry! ) (if (and pt sset) (progn ; If all is well, (command ".attedit" "" "" "" "" pt "" ) ; Start the ATTEDIT (if value (command "v" "r" value)) ; function and do (if angle (command "a" angle)) ; each one that was (if style (command "s" style)) ; requested and (if layer (command "l" layer)) ; that has a value. (if color (command "c" color )) (if hgt (command "h" hgt )) ; If the position (if pos ; was requested, (progn ; give an additional (Prompt "\n New Position: ") ; prompt since we (command "p" pause ) ; turned off the ) ; command echo! ) (command "") ; Terminate the ) ; command. ) (setq pt (getpoint "\nSelect Attribute: ")) ; Get a new point! ));/* End of File */
still thanks for your time
PMXcad This post may have some thing useful http://www.cadtutor.net/forum/showthread.php?97667-Auto-rotaing-text-to-any-UCS
页:
[1]