搜索块实体
我有一个包含代表一个设备的一些行的块，旁边有一个数字（文本）作为该设备的索引。我将此块插入到绘图中。有时我需要使用Autolisp例程更改该块的某些属性（扩展数据）。然而，我也需要把这个数字从1号改为2号。我如何搜索块中的实体而不必分解它，找到我想要的（文本）并更改它？这对街区有可能吗？ 您是在更改属性还是单个文本值之后？你可以上传之前和之后的图像或绘图？ 单个文本值，与属性无关。块只是一些非常简单的行（3~4），在它们旁边有一个简单的文本“1”，用作用户的索引。此dwg作为块插入到其他主dwg文件中。它必须始终作为块插入。 所以你想在选择块中搜索一个特定的值，或者只是根据用户的输入更改所有文本值？ 关在黑暗中
(defun c:Test (/ doc ss in)
;; Tharwat 11.May. 2014 ;;
(if (and (/= (setq in (getstring t "\n Type a text to replace in block :")) "")
(princ "\n *** Select blocks ***")
(setq ss (ssget "_:L" '((0 . "INSERT"))))
)
(progn (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
((lambda (x / sn en lst nm e el)
(while (setq sn (ssname ss (setq x (1+ x))))
(if (not (member (setq nm (cdr (assoc 2 (setq en (entget sn))))) lst))
(progn (setq lst (cons nm lst))
(setq e (tblobjname "BLOCK" nm))
(while (setq e (entnext e))
(if (wcmatch (cdr (assoc 0 (setq el (entget e)))) "*TEXT")
(entmod (subst (cons 1 in) (assoc 1 el) el))
)
)
)
)
)
)
-1
)
(vla-endundomark doc)
(vla-regen doc Acallviewports)
)
)
(princ)
)(vl-load-com)
仅用于文本。
(vl-load-com)
(defun C:GZ ()
(command "undo" "be")
(setq olderr *error* ; Initialize variables
*error* chgterr
)
(setvar "CMDECHO" 0)
(command "ucs" "w")
(setq *App (vlax-get-acad-object))
(setq *Doc (vla-get-ActiveDocument *APP))
(setq SS (nentsel "\nPlease pick the text: "))
(setq ENT (entget (car SS))
PT(cadr SS)
PT11PT
)
(setq ens1 (last SS))
(if(not (equal PT ens1 0.1))
(setqens (last (last SS))
mat (RevRefGeom ens)
PT11 (MCS2WCS mat PT11 )
obj (vlax-ename->vla-object ens)
name (vla-get-name obj)
)
)
(if (= (cdr (assoc 0 ENT)) "TEXT")
(progn
(entmake ENT)
(setq ent1 (entlast))
(setq el1(entget ent1))
(setqSTR (cdr (assoc 1 ENT)))
(setq dq1 (setq dqb1 (assoc 72 el1)))
(setq dq2 (setq dqb2 (assoc 73 el1)))
(if (/= dq1 0)
(progn
(setq p11 (assoc 11 el1))
(setq p11b '(0.0 0.0 0.0))
(setq el1 (subst (cons 11 p11b) p11 el1))
(setq dq 0)
(setq el1 (subst (cons 72 dq) dqb1 el1))
(if (/= dq2 0)
(setq el1 (subst (cons 73 dq) dqb2 el1))
)
(entmod el1)
)
)
(setq LST '())
(setq LTT '())
(setq lls "")
(setq ijk nil)
(while (/= STR "")
(setq step 0)
(if (> (ascii (substr STR 1 1)) 159)
(progn
(setq STRI (substr STR 1 2))
(setqLST(cons STRI LST))
(setqLST(cons STRI LST))
(setqSTR(substr STR 3))
(if (not ijk)
(progn
(setq lls (strcat lls STRI))
(entmod (setq el1 (subst (cons 1 lls)
(assoc 1 el1)
el1
)
)
)
(if (setq xx (CheckWidth ent1 PT11) )
(progn
(entdel ent1)
(setq strr(getstring (strcat "\nPlease enter a new text:[" STRI "]"))
LTT (cons strr LTT)
ijk T
)
)
(setqLTT(cons STRI LTT))
)
) ; progn
(setqLTT(cons STRI LTT))
)
);(progn
(progn
(if (and (< (asj 2) 159)(< (asj 3) 159)(< (asj 4) 159)(< (asj 5) 159)(wcmatch (substr STR 1 5) "%%**") )
; (if (wcmatch (substr STR 1 5) "%%**")
(if (wcmatch (substr STR 1 5) "%%")
(setq STRI (substr STR 1 5)
STR(substr STR 6)
step5)
(setq STRI (substr STR 1 3)
STR(substr STR 4))
)
;endif
(setq STRI (substr STR 1 1)STR(substr STR 2) )
)
(setqLST(cons STRI LST))
(if (not ijk)
(progn
(setq lls (strcat lls STRI))
(entmod (setq el1 (subst (cons 1 lls)
(assoc 1 el1)
el1
)
)
)
(if (setq xx (CheckWidth ent1 PT11) )
(progn
(entdel ent1)
(setq strr(getstring (strcat "\nPlease enter a new text:[" STRI "]")))
(if (= step 5)
(progn
(if (= strr "1") (setq strr "%%129"))
(if (= strr "2") (setq strr "%%130"))
(if (= strr "3") (setq strr "%%160"))
(setq step 0)
)
)
(setq step 0)
(setq LTT (cons strr LTT)
ijk T
)
)
(setqLTT(cons STRI LTT))
)
)
(setqLTT(cons STRI LTT))
)
);progn
) ; (if (> (ascii (substr STR 1 1)) 159)
(setq STRI "")
) ; while
;(entdel ent1)
(setq LTT (reverse LTT))
(setq LST (reverse LST))
(setq ttx "")
(setq kkk 0)
(while (< kkk (length LTT))
(setq ttx (strcat ttx (nth kkk LTT)))
(setq kkk (1+ kkk))
)
(entmod (subst (cons 1 ttx) (assoc 1 ENT) ENT))
(if(not (equal PT ens1 0.1))
(progn
(setq bbs (ssget "X" '((0 . "insert")) ))
(setq i 0)
(while (<i (sslength bbs) )
(setq nai (ssname bbs i))
(setq enn (entget nai))
(setq nam (cdr (assoc 2 enn)))
(if (= nam name)
(progn(entdel nai) (entdel nai) )
)
(setq i ( 1+ i ) )
)
; (entdel ens)
;(entdel ens)
)
)
)
)
(setq *error* olderr) ; Restore old *error* handler
(command "undo" "e")
(command "ucs" "p")
(princ)
) ;
(defun ASj (jj0 / asjj)
(setq asjj (ascii (substr STR jj0 1)))
)
(defun CheckWidth (textent selpt / );ll ur hbox)
(command "ucs" "Object" textent)
(setq selpt (trans selpt 0 1))
(setq ll (car (textbox (entget textent)))
ur (cadr (textbox (entget textent)))
wid(abs (- (car ur) (car ll)))
wid1 (abs (- (car selpt) (car ll)))
hbox (/ (PickBoxSize) 2.0)
)
(command "ucs" "p")
(if (> wid (- wid1 hbox))
T
nil
)
)
;;----------------------------------------
(defun PickBoxSize (/ SS VS PB SWP SHP AR WSD PPDU BOX)
(setq SSc (getvar "SCREENSIZE") ; screen size in pixels
VS (getvar "VIEWSIZE") ; screen height in drawing units
PB (getvar "pickbox") ; get current pickbox size
SWP(car SSc) ; width of screen in pixels
SHP(cadr SSc) ; height of screen in pixels
AR (/ SWP SHP) ; aspect ratio width/height
WSD(* VS AR) ; width of screen dwg units = ratio timesheight
PPDU (/ WSD SWP) ; pixels per drawing unit
BOX(/ (* VS (* 2 PB)) SHP) ; drawing units per pixel
)
)
;;; This routine is from gile,I revised some places for a better algorithm.
;;; Thanks a lot. -highflybird 2009/2/22
;;; =========================================================================
;;; RefGeom (gile)
;;; returns a list which first item is a 3x3 transformation matrix (rotation,
;;; scales, normal) and second item the object insertion point in its parent
;;; (xref, bloc or space)
;;; Argument : an ename
;;; =========================================================================
(defun RefGeom (ename / Lst ang Nor mat Org Ins Ax Ay Sx Sy Sz)
(setq Lst (entget ename) ; the name of entity
Nor (cdr (assoc 210 Lst)) ; normal
Sx(cdr (assoc 41Lst)) ; X scale factor
Sy(cdr (assoc 42Lst)) ; Y scale factor
Sz(cdr (assoc 43Lst)) ; Z scale factor
Ang (cdr (assoc 50Lst)) ; rotation angle
Ax(cos Ang) ; the value of cosine
Ay(sin Ang) ; the value of sine
mat (mxm
(list
(trans '(1.0 0.0 0.0) 0 Nor T) ; transform X axis
(trans '(0.0 1.0 0.0) 0 Nor T) ; transform Y axis
(trans '(0.0 0.0 1.0) 0 Nor T) ; transform Z axis
)
(list
(list (* Ax Sx) (- (* Ay Sy)) 0.) ; multiple Scale Matrix and rotation Matrix
(list (* Ay Sx) (* Ax Sy) 0.)
(list 0.0 0.0 Sz)
)
)
Org (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 Lst))))) ; get the origin of the block
Ins (trans (cdr (assoc 10 Lst)) Nor 0) ; transformate insertpoint
)
(if (/= Org '(0.0 0.0 0.0)) ; if the origin isn't '(0 0 0)
(setq Ins (mapcar '- Ins (mxv mat Org))) ; then insertpoint needs a displacement
)
(setq mat (mapcar 'App2Last mat Ins) ; to make a standard transformation matrix
mat (App2Last mat '(0.0 0.0 0.0 1.0))
)
)
;; RevRefGeom (gile)
;; RefGeom inverse function
(defun RevRefGeom (ename / Data ang norm mat ins)
(setq Data (entget ename)
ang(- (cdr (assoc 50 Data)))
norm (cdr (assoc 210 Data))
mat(mxm
(list (list (/ 1 (cdr (assoc 41 Data))) 0.0 0.0)
(list 0.0 (/ 1 (cdr (assoc 42 Data))) 0.0)
(list 0.0 0.0 (/ 1 (cdr (assoc 43 Data))))
)
(mxm
(list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(mapcar (function (lambda (v) (trans v norm 0 T)))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
)
)
ins(mapcar
'-
(cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 Data)))))
(mxv mat (trans (cdr (assoc 10 Data)) norm 0))
)
mat(mapcar 'App2Last mat ins)
mat(App2Last mat '(0.0 0.0 0.0 1.0))
)
)
;;; Append a element to the last
(defun App2Last (m v)
(list (car m) (cadr m) (caddr m) v)
)
;;; VXV Returns the dot product of 2 vectors
(defun vxv (v1 v2)
(apply '+ (mapcar '* v1 v2))
)
;;; TRP Transpose a matrix -Doug Wilson-
(defun trp (m)
(apply 'mapcar (cons 'list m))
)
;;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
(defun mxv (m v)
(mapcar '(lambda (r) (vxv r v)) m)
)
;;; MXM Multiply two matrices -Vladimir Nesterovsky-
(defun mxm (m q)
(mapcar '(lambda (r) (mxv (trp q) r)) m)
)
;;; MCS to WCS -- revised by highflybird
(defun MCS2WCS (mat P / p1)
(setq p1 (App2Last p 1))
(list
(vxv (car mat) p1)
(vxv (cadr mat) p1)
(vxv (caddr mat) p1)
)
)
谢谢你们俩的帮助。然而，这些例程存在一个问题。当我拾取块时，文本将更改为该块的所有副本。我的目的是只更改我选择的块的文本。这会是一个问题吗？
那么，您想在块中的文本处拾取以更改其值？ 是的，或多或少。确切地说，我想选择另一个带有文本的块，比如说，“2”，然后一些块带有“1”，最后我用“1”创建的选择集变成“2”。我不需要所有的代码。我只是想知道，当我在内存中存储“2”信息时，如何在块元素中更改“1”。 MJLM，
您意识到您还需要更改块名称，除非您使用属性，否则不能有两个或多个具有相同名称和不同内容的块。。。。（您使用ACAD多久了？）
页:
[1]
2