TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: myloveflyer on February 11, 2011, 09:34:27 PM
-
Recently wrote a small program, a little question to ask you.
For example there are many words beginning with the letter, I need to extract them, and then replaced with new text, for example: A12, B34, C36, D75. . . I need to replace them A12 = 1 B34 = 2. . . That is, the corresponding A 1, B corresponds to 2. . . , The following procedures in the corresponding relationship problems, and execution errors. :cry:
(if (not (tblsearch "layer" "qh"))
(command "layer" "n" "qh" "c" "2" "qh" "")
)
(defun c:test()
(svos)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setq con1 (getpoint "\nFrist point:"))
(setq con2 (getcorner con1 "\nSecond point:"))
(setq sq (ssget "w" con1 con2 '((1 . "[a-A-z-Z]*"))))
(command "chprop" sq "" "la" "qh" "")
(setq ob_number (sslength sq))
(setq i 0)
(while (< i ob_number)
(setq text_code (entget (ssname sq i)))
(setq txtValue (assoc 1 text_code))
(if (= (substr txtValue 1 1) "A")
(progn (setq new_txtValue "1")
(setq text_code (subst (cons 1 new_txtValue) (assoc 1 text_code) text_code))
(entmod text_code)
))
(setq i (+ i 1))
);end_while i
(clos)
(princ)
)
-
Quick 'n' Dirty based on your description:
(defun c:test ( / s i n l )
(if (setq s (ssget "_:L" '((0 . "TEXT") (1 . "@##"))))
(repeat (setq i (sslength s))
(setq n (ascii (strcase (cdr (assoc 1 (setq l (entget (ssname s (setq i (1- i))))))))))
(entupd (cdr (assoc -1 (entmod (subst (cons 1 (itoa (- n 64))) (assoc 1 l) l)))))
)
)
(princ)
)
Or, a little less readable:
(defun c:test ( / s i l )
(if (setq s (ssget "_:L" '((0 . "TEXT") (1 . "@##"))))
(repeat (setq i (sslength s))
(entupd
(cdr
(assoc -1
(entmod
(subst
(cons 1
(itoa
(-
(ascii
(strcase
(cdr
(assoc 1
(setq l
(entget
(ssname s (setq i (1- i)))
)
)
)
)
)
)
64
)
)
)
(assoc 1 l) l
)
)
)
)
)
)
)
(princ)
)
-
LEE,Nice work,Thank you!
this "(setq s (ssget "_:L" '((0 . "TEXT") (1 . "@##"))))"
Write when in the selected issues, such as the time when the A119 will occur not on the selection, there is the ability to ensure that when the text is replaced in the circle,
(if (not (tblsearch "layer" "qh"))
(command "layer" "n" "qh" "c" "2" "qh" "")
)
(defun c:test1 ( / ss i n elist )
(setq con1 (getpoint "\nFrist point:"))
(setq con2 (getcorner con1 "\nSecond point:"))
(if (setq s (ssget "w" con1 con2 '((1 . "[a-A-z-Z]*"))))
(repeat (setq i (sslength s))
(setq n (ascii (strcase (cdr (assoc 1 (setq l (entget (ssname s (setq i (1- i))))))))))
(entupd (cdr (assoc -1 (entmod (subst (cons 1 (itoa (- n 64))) (assoc 1 l) l)))))
)
)
(command "chprop" s "" "la" "qh" "")
(princ)
)
-
look
http://www.gr-acad.com.br/Pacote/alttexto.html
-
LEE,Nice work,Thank you!
this "(setq s (ssget "_:L" '((0 . "TEXT") (1 . "@##"))))"
Write when in the selected issues, such as the time when the A119 will occur not on the selection, there is the ability to ensure that when the text is replaced in the circle,
You're welcome :-)
Perhaps this is better:
(defun c:test ( / s i l )
(if (null (tblsearch "LAYER" "qh"))
(entmake
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 "qh")
(cons 70 0)
(cons 62 2)
)
)
)
(if (setq s (ssget "_:L" '((0 . "TEXT") (1 . "@#*"))))
(repeat (setq i (sslength s))
(entupd
(cdr
(assoc -1
(entmod
(subst
(cons 1
(itoa
(-
(ascii
(strcase
(cdr
(assoc 1
(setq l
(entget
(ssname s (setq i (1- i)))
)
)
)
)
)
)
64
)
)
)
(assoc 1 l)
(subst (cons 8 "qh") (assoc 8 l) l)
)
)
)
)
)
)
)
(princ)
)
-
look
http://www.gr-acad.com.br/Pacote/alttexto.html
Need eglish version . 8-)
-
Nice work,LEE.Thanks
But now there is a problem, that is, if and when A123 = 1A or whatever, the program needs to change, and can not make a list, replace the contents of the people to determine, for example (("A" 1a) ("B" 2214 ) ("C" 3a9) ... ...), then the user select the first letter of the text in the table to find the appropriate value, and then replaced.
:evil:
-
I'm not sure that I understand - does my code not meet your needs? :?
-
Sorry,Lee. :cry:
I might have a problem with the description, your program is only for when the above A123 = 1, B23 = 2, etc., but for A123 = 1a or other, there will be problems, can provide a list,for example(setq lst '(("A" 1a) ("B" 2214 ) ("C" 3a9) ... ...)), when select text "A123",query in the list, find the appropriate content, and then replace the text,obtained A123 = 1a,etc.
-
Perhaps something like this:
(defun c:test ( / a l i s p ) ; <-- Couldn't resist
(setq a
'(
("A" . "1a")
("B" . "2214")
("C" . "3a9")
)
)
(if (null (tblsearch "LAYER" "qh"))
(entmake
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 "qh")
(cons 70 0)
(cons 62 2)
)
)
)
(if (setq s (ssget "_:L" '((0 . "TEXT") (1 . "@#*"))))
(repeat (setq i (sslength s))
(if
(setq p
(cdr
(assoc
(strcase
(substr
(cdr
(assoc 1
(setq l
(entget
(ssname s (setq i (1- i)))
)
)
)
)
1 1
)
)
a
)
)
)
(entupd
(cdr
(assoc -1
(entmod
(subst
(cons 1 p) (assoc 1 l) (subst (cons 8 "qh") (assoc 8 l) l)
)
)
)
)
)
)
)
)
(princ)
)
-
LEE,cool. :evil:
Thanks.
-
You're welcome MyLoveFlyer, I hope you could learn from my code :-)