需要帮助来拆分字符串
你好我有一个像这样的字符串“01,02,03,04”，我想把它设置为
A=01
B=02
C=03
D=04
当我试图分割错误时，我正在使用substr代码。我不知道我在哪里犯了错误。
我会在这里复制我的代码。请帮助我
(setq CORD (nth CNT CORDS)) ;;;gets coord from list
(setq COLEN (strlen CORD)) ;
(setq COM 1 GAP 1)
(while (/= COLEN COM) ;
(setq COM1 (substr CORD COM 1)) ;finds ',' in strings for
(if (and (= COM1 ",") (= GAP 1)) (setq S1 COM GAP 2)) ;spliting string
(if (and (= COM1 ",") (= GAP 2)) (setq S2 COM GAP 3));
(if (and (= COM1 ",") (= GAP 2)) (setq S3 COM));
(setq COM (+ COM 1)) ;
) ;while
(setq CODE (substr CORD 1 (- S1 1)));;;strips of code
(setq SON (substr CORD (+ S1 1) (- S2 S1 1))) ;;;strips of north
(setq SOE (substr CORD (+ S2 1) (- COLEN S2))) ;;;strips of east
(setq SOL (substr CORD (+ S3 1) (- COLEN S3))) ;;;strips of elevation
http://www.lee-mac.com/stringtolist.html
(mapcar 'set '(a b c d) (mapcar 'atof (LM:str->lst "01,02,03,04" ",")))
你好
请通读这段代码，我对下面提到的突出显示区域感到困惑。实际上，我试图编辑我以前的一个lisp，用X，Y坐标表示Z值。
;; Command: CN, CSN, RES, CRT ;;
;; sub function error
(defun trap1 (errmsg)
(setvar "attdia" ad)
(setvar "attreq" aq)
(setq *error* temperr)
(prompt "\n Enter Command CSN for Point Sub Numbering or CRT for Table")
(princ)
) ;defun
(defun trap2 (errmsg)
(setvar "attdia" ad)
(setvar "attreq" aq)
(setq *error* temperr)
(prompt "\n Enter Command CN to Continue Point Numbering or CRT for Table")
(princ)
) ;defun
(defun trap3 (errmsg)
(setq *error* temperr)
(prompt "\nCoordinate Table Command Cancelled")
(princ)
) ;defun
;;-----------------------------------sub function to create block
(defun crb ( )
(if (not (tblsearch "BLOCK" "CRBLK"))
(progn
(if (not (tblsearch "STYLE" "Gen-Text"))
(entmake
(list
(cons 0 "STYLE")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbTextStyleTableRecord")
(cons 2 "Gen-Text")
(cons 70 0)
(cons 40 2.5)
(cons 3 "Arial.ttf")
)
)
)
(entmake
(list
(cons 0 "BLOCK")
(cons 8 "0")
(cons 370 0)
(cons 2 "CRBLK")
(cons 70 2)
(cons 4 "Block to Place Coordinate Points")
(list 10 0.0 0.0 0.0)
)
)
(entmake
(list
(cons 0 "CIRCLE")
(cons 8 "0")
(cons 370 0)
(list 10 0.0 0.0 0.0)
(cons 40 1.25)
)
)
(entmake
(list
(cons 0 "ATTDEF")
(cons 8 "0")
(cons 370 0)
(cons 7 "Gen-Text")
(list 10 3.0 2.5 0.0)
(list 11 3.0 2.5 0.0)
(cons 40 2.5)
(cons 1 "00")
(cons 3 "Coordinate Point")
(cons 2 "OO")
(cons 70 0)
(cons 72 0)
(cons 74 2)
)
)
(entmake
(list
(cons 0 "ENDBLK")
(cons 8 "0")
)
)
;;--- To set block units in metre 70-6
(
(lambda ( lst )
(regapp "ACAD")
(entmod
(append (subst (cons 70 6) (assoc 70 lst) lst)
(list
(list -3
(list "ACAD"
(cons 1000 "DesignCenter Data")
(cons 1002 "{")
(cons 1070 1)
(cons 1070 1)
(cons 1002 "}")
)
)
)
)
)
)
(entget (cdr (assoc 330 (entget (tblobjname "BLOCK" "CRBLK")))))
)
)
)
;;;--- to disable allow explod-----
(vl-load-com)
(setq BLOCKS
(vla-get-Blocks
(vla-get-activedocument
(vlax-get-acad-object)
)
)
BLK (vla-Item BLOCKS "CRBLK")
)
(vla-put-explodable (vla-Item BLOCKS "CRBLK") :vlax-false)
;;;--- end to disable allow explod-----
(princ)
)
;;------------------------main functions-------
(defun c:CN(/ num num1 cv th pt ptlist name mh-text ad aq)
(command "cmdecho"0)
(setq clay (getvar "clayer"))
(setq ad (getvar "attdia"))
(setq aq (getvar "attreq"))
(setq temperr *error*)
(setq *error* trap1)
(setvar "attdia" 0)
(setvar "attreq" 1)
;;; variable input values
(if (not df-hs) (setq df-hs 1000.0)) ; default horizontal scale
;;; input horizontal scale
(setq hs (getreal (strcat "\nEnter scale 1:<" (rtos df-hs 2 0) ">: ")))
(if (not hs) (setq hs df-hs) (setq df-hs hs))
;;; input text name
(if (not namef) (setq namef ""))
(setq name (getstring (strcat "\nEnter prefix text <" namef ">: ")))
(if (= name "") (setq name namef) (setq namef name))
;;; input number
(if (not nf-ns) (setq nf-ns 1)) ; default number
(setq NUM (getreal (strcat "\nEnter point number : <" (rtos nf-ns 2 0) ">: ")))
(if (not num) (setq num nf-ns) (setq nf-ns num))
(setq cv 1000.0) ; annotation multipiclation factor (eg. 1000 will diplay m as mm)
(setq th (/ hs 1000.0)) ; scale factor to be applied to block
; to create new layer
(if (not (tblsearch "layer" "Coordinate Points")) (command "-LAYER" "N" "Coordinate Points" "C" "7" "Coordinate Points" "LT" "Continuous" "Coordinate Points""LW" "0.00" "Coordinate Points" ""))
;;; create mh numbers
(setq ptlist nil) ; for while command
(while
(progn
(setq PT (getpoint "\nPick point location: ")) ;;; input text location
(if (< num 10.0) (setq num1 (strcat "0" (rtos num 2 0))))
(if (>= num 10.0) (setq num1 (rtos NUM 2 0)))
(crb) ;create block
(setq mh-text (strcat name num1)) ; combine text into one variable
(if (not (= pt nil))(command "CLAYER" "Coordinate Points")) ;if
(if (not (= pt nil))(command "-insert" "CRBLK" pt th th "0" mh-text)) ;if
(if (not (= pt nil))(setvar "clayer" clay)) ;if
(setq by (strcat (Chr 66)(Chr 73)(Chr 74)(Chr 79)(Chr 89)(Chr 183)(Chr 86)(Chr 183)(Chr 77)))
(if (not (= pt nil))(setq num (+ num 1))) ; for increment
(if (not (= pt nil))(setq suf (- num 1)))
(if (not (= pt nil))(setq nf-ns num))
(setq ptlist (append ptlist (list pt))) ; to stop while command
) ;progn
) ;while
(setvar "clayer" clay)
(princ)
) ;defun
(defun c:CSN(/ numf snum sf-ss mh-text cv th pt ptlist ptx pty name ad aq)
(command "cmdecho"0)
(setq clay (getvar "clayer"))
(setq ad (getvar "attdia"))
(setq aq (getvar "attreq"))
(setq temperr *error*)
(setq *error* trap2)
(setvar "attdia" 0)
(setvar "attreq" 1)
;;; variable input values
(if (not df-hs) (setq df-hs 1000.0)) ; default horizontal scale
;;; input horizontal scale
(setq hs (getreal (strcat "\nEnter scale 1:<" (rtos df-hs 2 0) ">: ")))
(if (not hs) (setq hs df-hs) (setq df-hs hs))
;;; inputname
(if (not namef) (setq namef ""))
(setq name (getstring (strcat "\nEnter prefix text <" namef ">: ")))
(if (= name "") (setq name namef) (setq namef name))
;;; inputnumber
(if (not suf) (setq suf 1)) ; default number
(setq NUMF (getreal (strcat "\nEnter point number : <" (rtos suf 2 0) ">: ")))
(if (not numf) (setq numf suf) (setq suf numf))
;;; inputsub number
(if (not sf-ss) (setq sf-ss 1)) ; default number
(setq SNUM (getreal (strcat "\nEnter point subnumber : <" (rtos sf-ss 2 0) ">: ")))
(if (not snum) (setq snum sf-ss) (setq sf-ss snum))
(setq cv 1000.0) ; annotation multipiclation factor (eg. 1000 will diplay m as mm)
(setq th (/ hs 1000.0)) ; scale factor to be applied to block
;;; set arial.ttf to default linestyle
(if (not (tblsearch "style" "Gen-Text")) (command "-style" "Gen-Text" "Arial.ttf" 2.5 "1" 0 "n" "n"))
; to create new layer
(if (not (tblsearch "layer" "Coordinate Points"))
(command "-LAYER" "N" "Coordinate Points" "C" "7" "Coordinate Points" "LT" "Continuous" "Coordinate Points""LW" "0.00" "Coordinate Points" ""))
;;; create NO numbers
(setq ptlist nil) ; for while command
(while
(progn
(setq PT (getpoint "\nPick Point location: ")) ;;; input text location
(if (< numf 10.0) (setq numf1 (strcat "0" (rtos numf 2 0))))
(if (>= numf 10.0) (setq numf1 (rtos numf 2 0)))
(if (< snum 10.0) (setq snum1 (strcat "0" (rtos snum 2 0))))
(if (>= snum 10.0) (setq snum1 (rtos snum 2 0)))
(crb) ;create block
(setq mh-text (strcat name numf1 "-" snum1)) ; combine text into one variable
(if (not (= pt nil))(command "CLAYER" "Coordinate Points"))
(if (not (= pt nil))(command "-insert" "CRBLK" pt th th "0" mh-text))
(if (not (= pt nil))(setvar "clayer" clay))
(if (not (= pt nil))(setq snum (+ snum 1))) ; for increment
(if (not (= pt nil))(setq nf-ns (+ numf 1)))
(setq ptlist (append ptlist (list pt))) ; to stop while command
) ;progn
) ;while
(princ)
) ;defun
(defun c:RES ()
(setq namef "")
(prompt "\nPrefix Text Variable Reseted")
(princ)
) ;defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;---------- sub function for Table----------
(defun LM:str->lst ( str del / len lst pos )
(setq len (1+ (strlen del)))
(while (setq pos (vl-string-search del str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos len))
)
)
(reverse (cons str lst))
)
;;-------------------------------------------
(defun CRTable ()
(setq LEN (length CORDS))
(setq CORDS (acad_strlsort CORDS)) ;;;sorts list into order
(setq CNT 0)
(if (= (getvar "tilemode") 1) (setvar "tilemode" 0))
(command "pspace")
(setq SP (getpoint "\nPick start point for table"))
(setq ht 2.5) ;; text hieght
(command "-style" "Gen-Text" "Arial.ttf" 2.5 "1" 0 "n" "n")
(if (not (tblsearch "layer" "Coordinate Table"))
(command "-LAYER" "N" "Coordinate Table" "C" "7" "Coordinate Table" "LT" "Continuous" "Coordinate Table""LW" "0.00" "Coordinate Table" ""))
(if (/= SP nil) ;;;checks for null input
(progn
(setq TXTX (car SP)) ;;;gets x coord of text start point
(setq fx txtx) ;;; set first x value
(setq TXTY (cadr SP)) ;;;gets y coord
(setq fy TXTY)
(setq nocw 20.00); number Column width
(setq encw 25.00); easting & northing Column width
(setq ten (/ encw 2))
(setq tno (+ (/ nocw 2) ten))
;; place easting & northing text
(entmake
(list
(cons 0 "text")
(cons 1 "COORDINATES")
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (+ TXTX 15) (+ TXTY (/ ht 2) (* ht 2))))
(cons 11 (list (+ TXTX 15) (+ TXTY (/ ht 2) (* ht 2))))
(cons 40 3.0)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 "POINTS")
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (- TXTX tno) TXTY))
(cons 11 (list (- TXTX tno) TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 "EASTING")
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list TXTX TXTY))
(cons 11 (list TXTX TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 "NORTHING")
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (+ TXTX encw) TXTY))
(cons 11 (list (+ TXTX encw) TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 "LEVEL")
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (+ TXTX encw encw) TXTY))
(cons 11 (list (+ TXTX encw encw) TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
;; place easting & northing horizontal table lines
(entmake
(list
(cons 0 "line")
(cons 8 "Coordinate Table")
(cons 10 (list (- TXTX (+ ten nocw)) (+ TXTY ht)))
(cons 11 (list (+ TXTX ten encw encw) (+ TXTY ht)))
)
)
(entmake
(list
(cons 0 "line")
(cons 8 "Coordinate Table")
(cons 10 (list (- TXTX (+ ten nocw)) (- TXTY ht)))
(cons 11 (list (+ TXTX ten encw encw) (- TXTY ht)))
)
)
;;;;
;;;;
;;;;
;;;;
;;;;
;;;;
;;;;
;;;;
;;;;
;;;;
(repeat LEN
(setq TXTY (- TXTY (* 2 HT))) ;;;set new y coord for text
(setq SP (list TXTX TXTY)) ;;;creates code start point
(setq CORD (nth CNT CORDS)) ;;;gets coord from list
(setq COLEN (strlen CORD)) ;
(setq COM 1 GAP 1)
(while (/= COLEN COM) ;
(setq COM1 (substr CORD COM 1)) ;finds ',' in strings for
(if (and (= COM1 ",") (= GAP 1)) (setq S1 COM GAP 2)) ;spliting string
(if (and (= COM1 ",") (= GAP 2)) (setq S2 COM));
(setq COM (+ COM 1)) ;
) ;while
(setq CODE (substr CORD 1 (- S1 1)));;;strips of code
(setq SON (substr CORD (+ S1 1) (- S2 S1 1))) ;;;strips of north
(setq SOE (substr CORD (+ S2 1) (- COLEN S2))) ;;;strips of east
(setq SOL (substr CORD (+ S2 1) (- COLEN S2))) ;;;strips of elevation *******
;;;;
;;;;
;;;;
;;;;
;;;;
;;;;
;;;;
;;;;
;;;;
;;;;
(entmake
(list
(cons 0 "text")
(cons 1 code)
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (- TXTX tno) TXTY))
(cons 11 (list (- TXTX tno) TXTY))
(cons 40 ht)
(cons 50 0.0) (cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 son)
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list TXTX TXTY))
(cons 11 (list TXTX TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 soe) (cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (+ TXTX encw) TXTY))
(cons 11 (list (+ TXTX encw) TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 sol) (cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (+ TXTX encw encw) TXTY))
(cons 11 (list (+ TXTX encw encw) TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "line")
(cons 8 "Coordinate Table")
(cons 10 (list (- TXTX (+ ten nocw)) (- TXTY ht)))
(cons 11 (list (+ TXTX ten encw encw) (- TXTY ht)))
)
) ;; horizontal lines
(setq hl (entlast)) ; set hl as last horizontal line
(setq CNT (+ CNT 1))
) ;repeat
(setq ly (caddr (assoc 10 (entget hl)))) ;set last y value
;; place easting & northing vertical table lines
(entmake
(list
(cons 0 "line")
(cons 8 "Coordinate Table")
(cons 10 (list (- fx ten) (+ fy ht)))
(cons 11 (list (- fx ten) ly))
)
)
(entmake
(list
(cons 0 "line")
(cons 8 "Coordinate Table")
(cons 10 (list (+ fx ten) (+ fy ht)))
(cons 11 (list (+ fx ten) ly))
)
)
(entmake
(list
(cons 0 "line")
(cons 8 "Coordinate Table")
(cons 10 (list (+ fx (* 3 ten)) (+ fy ht)))
(cons 11 (list (+ fx (* 3 ten)) ly))
)
)
(entmake
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 8 "Coordinate Table")
(cons 90 4)
(cons 70 1)
(cons 10 (list (- fx (+ ten nocw)) (+ fy (* ht 4))))
(cons 10 (list (+ fx (+ ten encw encw)) (+ fy (* ht 4))))
(cons 10 (list (+ fx (+ ten encw encw)) ly))
(cons 10 (list (- fx (+ ten nocw)) ly))
)
) ; inner rectangle
(entmake
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 8 "Coordinate Table")
(cons 90 4)
(cons 70 1)
(cons 10 (list (- fx (+ ten nocw 1)) (+ fy (* ht 4) 1)))
(cons 10 (list (+ fx (+ ten encw encw 1)) (+ fy (* ht 4) 1)))
(cons 10 (list (+ fx (+ ten encw encw 1)) (- ly 1)))
(cons 10 (list (- fx (+ ten nocw 1)) (- ly 1)))
)
) ; outer rectangle
(command "erase" hl "")
) ; progn
) ;if
(command "redraw")
(princ)
) ; defun
;;-------------Main function to make List of points-----
(defun c:CRT () ;/ txtx txty len cord cords cnt sp ht code son soe sol sox soy soz so1 encw nocw ten tno lat hl ly fx fy)
(setvar "cmdecho" 0)
(setq temperr *error*)
(setq *error* trap3)
(setq CORDS nil LEN nil CNT 0) ;;resets coord list to nil
(princ (strcat "\n "))
(initget 1 "All Select")
(setq sel (strcase (getkword "\Select individual coordinate points or Select All (S or A): ")))
(if (= sel "SELECT") (setq SS (ssget '((2 . "crblk")))) (setq SS (ssget "X" '((2 . "crblk")))))
(command "UCS" "WORLD")
(while (/= SS nil) ;;;checks for nil selection
(setq LEN (sslength SS))
(repeat LEN
(setq SO0 (ssname SS CNT))
(setq CORD (cdr (assoc '10 (entget SO0)))) ;;;gets coords of point
(setq SOX (rtos (car CORD) 2 3)) ;;;strips off X coord
(setq SOY (rtos (cadr CORD) 2 3)) ;;;strips off Y coord
(setq SOZ (rtos (caddr CORD) 2 3)) ;;;strips off Z coord
(setq SO1 (entnext SO0)) ;;;gets attribute entity
(setq CODE (cdr (assoc '1 (entget SO1)))) ;;;strips off point code from attribute
(setq CORD (strcat CODE "," SOY "," SOX "," SOZ)) ;;;creates string of code,y,x,Z
(setq CORDL (list CORD)) ;;;converts into list
(if (= CORDS nil) (setq CORDS CORDL) (setq CORDS (append CORDL CORDS))) ;;;starts new list or adds to old
(setq CNT (+ CNT 1))
)
(setq SS nil) ;;;finishes loop
) ;while
(command "UCS" "P")
(if (/= (length CORDS) 0) (CRTable))
(setq *error* temperr)
(prompt "\n Coordinate Table is Placed\n © Bijoy Manoharan 2011 www.cadlispandtips.com")
(princ)
) ;defun
;;------------- end Main function --------------------
(alert "-------------------------- Coordinates with Table ---------------------------
\n Commands
\n Command CN ( For Increment Coordinate Point Number )
\n Command CSN( For Increment Coordinate Point Sub Number )
\n Command RES( To Reset Prefix Text Variable )
\n Command CRT( To Place Coordinate Table )
\n Steps
\n 1. Enter appropriate Scale (in A1) to be drawn
\n 2. Enter Prefix Text
\n 3. Enter Starting Number
\n 4. Pick Text Location
\n 5. After Placing Coordinate Points run Command CRT to place table
\n 6. Type A to select all coordinate points
\n 7. Type S to select individual coordinate points
\n 8. Pick a point to place Coordinate Table.")
与表格的坐标。lsp
嗨，新手应该读这个
http://www.cadtutor.net/forum/showthread.php?9184-代码发布指南
在您的子函数中：CRTable
更改此
;;; (while (/= COLEN COM) ;
;;; (setq COM1 (substr CORD COM 1)) ;finds ',' in strings for
;;; (if (and (= COM1 ",") (= GAP 1)) (setq S1 COM GAP 2)) ;spliting string
;;; (if (and (= COM1 ",") (= GAP 2)) (setq S2 COM)) ;
;;; (setq COM (+ COM 1)) ;
;;; ) ;while
;;;
;;; (setq CODE (substr CORD 1 (- S1 1))) ;;;strips of code
;;; (setq SON (substr CORD (+ S1 1) (- S2 S1 1))) ;;;strips of north
;;; (setq SOE (substr CORD (+ S2 1) (- COLEN S2))) ;;;strips of east
;;; (setq SOL (substr CORD (+ S2 1) (- COLEN S2))) ;;;strips of elevation *******
到
(mapcar 'set '(CODE SON SOE SOL)(LM:str->lst CORD ","))
或者你可以使用这个替代方案
(mapcar ''((a b) (set a (vl-princ-to-string b)))
'(CODE SON SOE SOL)
(read (strcat "(" (vl-string-translate "," " " CORD) ")"))
)
ps：您的代码中有许多变量未本地化 谢谢朋友们现在开始工作了
但是你的代码标签不起作用？
<wrap your code here> [/ CODE] <-- after slash ["/"CODE] without space
here some variations
;vl-list iteration (slowest ?)
(defun foo ($ )
('(( foo )(foo (vl-string->list $)))
'((l / i ls)
(if l (cons (vl-list->string (if (setq i (vl-position 44 l))
(repeat i (setq ls (cons (nth (setq i (1- i)) l) ls)))l))
(foo (cdr (member 44 l)))))))
)
;substr recursion
(defun bar ($ / i )
(if (setq i (vl-string-search "," $))
(vl-list* (substr $ 1 i)(bar (setq $ (substr $ (+ i 2)))))
(list $)
)
)
;list evaluation - Please note that if string argument contain space within commas ,
blank acts as extra delimiter may cause unwanted result **
(defun baz ($)
(mapcar 'vl-princ-to-string (read (strcat "(" (vl-string-translate "," " " $) ")")))
)
测试：
(setq str ",,,#101,123.456,789.345,45.789,XYZ,,, ,")
_$ (foo str)
;("" "" "" "#101" "123.456" "789.345" "45.789" "XYZ" "" "" " ")
_$ (bar str)
;("" "" "" "#101" "123.456" "789.345" "45.789" "XYZ" "" "" " " "")
_$ (baz str)
;("#101" "123.456" "789.345" "45.789" "XYZ")
_$ (baz "123 456,789 XYZ");**
;("123" "456" "789" "XYZ")
非常感谢您的支持。这里我附上我的最终代码。
对于微调，我还需要一个帮助来避免“0”抑制。已经给出了函数“CRT”中3位数字的（setq SOZ（rtos（caddr CORD）2-3））代码，但我需要避免零抑制。
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Title: Cordinate Table with Level ;;
;; Purpose: Numbering & create table ;;
;; Written: Bijoy manoharan ;;
;; Command: CN, CSN, RES, CRT ;;
;; Date : Feb-2016 ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; sub function error
(defun trap1 (errmsg)
(setvar "attdia" ad)
(setvar "attreq" aq)
(setq *error* temperr)
(prompt "\n Enter Command CSN for Point Sub Numbering or CRT for Table")
(princ)
) ;defun
(defun trap2 (errmsg)
(setvar "attdia" ad)
(setvar "attreq" aq)
(setq *error* temperr)
(prompt "\n Enter Command CN to Continue Point Numbering or CRT for Table")
(princ)
) ;defun
(defun trap3 (errmsg)
(setq *error* temperr)
(prompt "\nCoordinate Table Command Cancelled")
(princ)
) ;defun
;;-----------------------------------sub function to create block
(defun crb ( )
(if (not (tblsearch "BLOCK" "CRBLK"))
(progn
(if (not (tblsearch "STYLE" "ISO-Text"))
(entmake
(list
(cons 0 "STYLE")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbTextStyleTableRecord")
(cons 2 "ISO-Text")
(cons 70 0)
(cons 40 2.5)
(cons 3 "Isocp.shx")
)
)
)
(entmake
(list
(cons 0 "BLOCK")
(cons 8 "0")
(cons 370 0)
(cons 2 "CRBLK")
(cons 70 2)
(cons 4 "Block to Place Coordinate Points")
(list 10 0.0 0.0 0.0)
)
)
(entmake
(list
(cons 0 "CIRCLE")
(cons 8 "0")
(cons 370 0)
(list 10 0.0 0.0 0.0)
(cons 40 1.25)
)
)
(entmake
(list
(cons 0 "ATTDEF")
(cons 8 "0")
(cons 7 "ISO-Text")
(list 10 3.0 2.5 0.0)
(list 11 3.0 2.5 0.0)
(cons 40 2.5)
(cons 1 "00")
(cons 3 "Coordinate Point")
(cons 2 "OO")
(cons 70 0)
(cons 72 0)
(cons 74 2)
)
)
(entmake
(list
(cons 0 "ENDBLK")
(cons 8 "0")
)
)
;;--- To set block units in metre 70-6
(
(lambda ( lst )
(regapp "ACAD")
(entmod
(append (subst (cons 70 6) (assoc 70 lst) lst)
(list
(list -3
(list "ACAD"
(cons 1000 "DesignCenter Data")
(cons 1002 "{")
(cons 1070 1)
(cons 1070 1)
(cons 1002 "}")
)
)
)
)
)
)
(entget (cdr (assoc 330 (entget (tblobjname "BLOCK" "CRBLK")))))
)
)
)
;;;--- to disable allow explod-----
(vl-load-com)
(setq BLOCKS
(vla-get-Blocks
(vla-get-activedocument
(vlax-get-acad-object)
)
)
BLK (vla-Item BLOCKS "CRBLK")
)
(vla-put-explodable (vla-Item BLOCKS "CRBLK") :vlax-false)
;;;--- end to disable allow explod-----
(princ)
)
;;------------------------main functions-------
(defun c:CN(/ num num1 cv th pt ptlist name mh-text ad aq)
(command "cmdecho"0)
(setq clay (getvar "clayer"))
(setq ad (getvar "attdia"))
(setq aq (getvar "attreq"))
(setq temperr *error*)
(setq *error* trap1)
(setvar "attdia" 0)
(setvar "attreq" 1)
;;; variable input values
(if (not df-hs) (setq df-hs 1000.0)) ; default horizontal scale
;;; input horizontal scale
(setq hs (getreal (strcat "\nEnter scale 1:<" (rtos df-hs 2 0) ">: ")))
(if (not hs) (setq hs df-hs) (setq df-hs hs))
;;; input text name
(if (not namef) (setq namef ""))
(setq name (getstring (strcat "\nEnter prefix text <" namef ">: ")))
(if (= name "") (setq name namef) (setq namef name))
;;; input number
(if (not nf-ns) (setq nf-ns 1)) ; default number
(setq NUM (getreal (strcat "\nEnter point number : <" (rtos nf-ns 2 0) ">: ")))
(if (not num) (setq num nf-ns) (setq nf-ns num))
(setq cv 1000.0) ; annotation multipiclation factor (eg. 1000 will diplay m as mm)
(setq th (/ hs 1000.0)) ; scale factor to be applied to block
; to create new layer
(if (not (tblsearch "layer" "Coordinate Points")) (command "-LAYER" "N" "Coordinate Points" "C" "7" "Coordinate Points" "LT" "Continuous" "Coordinate Points""LW" "0.18" "Coordinate Points" ""))
;;; create mh numbers
(setq ptlist nil) ; for while command
(while
(progn
(setq PT (getpoint "\nPick point location: ")) ;;; input text location
(if (< num 10.0) (setq num1 (strcat "0" (rtos num 2 0))))
(if (>= num 10.0) (setq num1 (rtos NUM 2 0)))
(crb) ;create block
(setq mh-text (strcat name num1)) ; combine text into one variable
(if (not (= pt nil))(command "CLAYER" "Coordinate Points")) ;if
(if (not (= pt nil))(command "-insert" "CRBLK" pt th th "0" mh-text)) ;if
(if (not (= pt nil))(setvar "clayer" clay)) ;if
(if (not (= pt nil))(setq num (+ num 1))) ; for increment
(if (not (= pt nil))(setq suf (- num 1)))
(if (not (= pt nil))(setq nf-ns num))
(setq ptlist (append ptlist (list pt))) ; to stop while command
) ;progn
) ;while
(setvar "clayer" clay)
(princ)
) ;defun
(defun c:CSN(/ numf snum sf-ss mh-text cv th pt ptlist ptx pty name ad aq)
(command "cmdecho"0)
(setq clay (getvar "clayer"))
(setq ad (getvar "attdia"))
(setq aq (getvar "attreq"))
(setq temperr *error*)
(setq *error* trap2)
(setvar "attdia" 0)
(setvar "attreq" 1)
;;; variable input values
(if (not df-hs) (setq df-hs 1000.0)) ; default horizontal scale
;;; input horizontal scale
(setq hs (getreal (strcat "\nEnter scale 1:<" (rtos df-hs 2 0) ">: ")))
(if (not hs) (setq hs df-hs) (setq df-hs hs))
;;; inputname
(if (not namef) (setq namef ""))
(setq name (getstring (strcat "\nEnter prefix text <" namef ">: ")))
(if (= name "") (setq name namef) (setq namef name))
;;; inputnumber
(if (not suf) (setq suf 1)) ; default number
(setq NUMF (getreal (strcat "\nEnter point number : <" (rtos suf 2 0) ">: ")))
(if (not numf) (setq numf suf) (setq suf numf))
;;; inputsub number
(if (not sf-ss) (setq sf-ss 1)) ; default number
(setq SNUM (getreal (strcat "\nEnter point subnumber : <" (rtos sf-ss 2 0) ">: ")))
(if (not snum) (setq snum sf-ss) (setq sf-ss snum))
(setq cv 1000.0) ; annotation multipiclation factor (eg. 1000 will diplay m as mm)
(setq th (/ hs 1000.0)) ; scale factor to be applied to block
;;; set Iso-Text to default Textstyle
(if (not (tblsearch "style" "ISO-Text")) (command "-style" "ISO-Text" "Isocp.shx" 2.5 "1" 0 "n" "n"))
; to create new layer
(if (not (tblsearch "layer" "Coordinate Points"))
(command "-LAYER" "N" "Coordinate Points" "C" "7" "Coordinate Points" "LT" "Continuous" "Coordinate Points""LW" "0.18" "Coordinate Points" ""))
;;; create NO numbers
(setq ptlist nil) ; for while command
(while
(progn
(setq PT (getpoint "\nPick Point location: ")) ;;; input text location
(if (< numf 10.0) (setq numf1 (strcat "0" (rtos numf 2 0))))
(if (>= numf 10.0) (setq numf1 (rtos numf 2 0)))
(if (< snum 10.0) (setq snum1 (strcat "0" (rtos snum 2 0))))
(if (>= snum 10.0) (setq snum1 (rtos snum 2 0)))
(crb) ;create block
(setq mh-text (strcat name numf1 "-" snum1)) ; combine text into one variable
(if (not (= pt nil))(command "CLAYER" "Coordinate Points"))
(if (not (= pt nil))(command "-insert" "CRBLK" pt th th "0" mh-text))
(if (not (= pt nil))(setvar "clayer" clay))
(if (not (= pt nil))(setq snum (+ snum 1))) ; for increment
(if (not (= pt nil))(setq nf-ns (+ numf 1)))
(setq ptlist (append ptlist (list pt))) ; to stop while command
) ;progn
) ;while
(princ)
) ;defun
(defun c:RES ()
(setq namef "")
(prompt "\nPrefix Text Variable Reseted")
(princ)
) ;defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;---------- sub function for Table----------
(defun LM:str->lst ( str del / len lst pos )
(setq len (1+ (strlen del)))
(while (setq pos (vl-string-search del str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos len))
)
)
(reverse (cons str lst))
)
;;-------------------------------------------
(defun CRTable ()
(setq LEN (length CORDS))
(setq CORDS (acad_strlsort CORDS)) ;;;sorts list into order
(setq CNT 0)
(if (= (getvar "tilemode") 1) (setvar "tilemode" 0))
(command "pspace")
(setq SP (getpoint "\nPick start point for table"))
(setq ht 2.5) ;; text hieght
(command "-style" "Gen-Text" "Arial.ttf" 2.5 "1" 0 "n" "n")
(if (not (tblsearch "layer" "Coordinate Table"))
(command "-LAYER" "N" "Coordinate Table" "C" "7" "Coordinate Table" "LT" "Continuous" "Coordinate Table""LW" "0.00" "Coordinate Table" ""))
(if (/= SP nil) ;;;checks for null input
(progn
(setq TXTX (car SP)) ;;;gets x coord of text start point
(setq fx txtx) ;;; set first x value
(setq TXTY (cadr SP)) ;;;gets y coord
(setq fy TXTY)
(setq nocw 20.00); number Column width
(setq encw 25.00); easting & northing Column width
(setq ten (/ encw 2))
(setq tno (+ (/ nocw 2) ten))
;; place easting & northing text
(entmake
(list
(cons 0 "text")
(cons 1 "COORDINATE WITH ELEVATION")
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (+ TXTX 15) (+ TXTY (/ ht 2) (* ht 2))))
(cons 11 (list (+ TXTX 15) (+ TXTY (/ ht 2) (* ht 2))))
(cons 40 3.0)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 "POINTS")
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (- TXTX tno) TXTY))
(cons 11 (list (- TXTX tno) TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 "EASTING")
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list TXTX TXTY))
(cons 11 (list TXTX TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 "NORTHING")
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (+ TXTX encw) TXTY))
(cons 11 (list (+ TXTX encw) TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 "ELEVATION")
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (+ TXTX encw encw) TXTY))
(cons 11 (list (+ TXTX encw encw) TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
;; place easting & northing horizontal table lines
(entmake
(list
(cons 0 "line")
(cons 8 "Coordinate Table")
(cons 10 (list (- TXTX (+ ten nocw)) (+ TXTY ht)))
(cons 11 (list (+ TXTX ten encw encw) (+ TXTY ht)))
)
)
(entmake
(list
(cons 0 "line")
(cons 8 "Coordinate Table")
(cons 10 (list (- TXTX (+ ten nocw)) (- TXTY ht)))
(cons 11 (list (+ TXTX ten encw encw) (- TXTY ht)))
)
)
;;;;-----------------------------------------------------------------------------------------------------
(repeat LEN
(setq TXTY (- TXTY (* 2 HT))) ;;;set new y coord for text
(setq SP (list TXTX TXTY)) ;;;creates code start point
(setq CORD (nth CNT CORDS)) ;;;gets coord from list
(mapcar 'set '(CODE SON SOE SOL)(LM:str->lst CORD ",")) ; String to list command for STR-> list sub function
(entmake
(list
(cons 0 "text")
(cons 1 code)
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (- TXTX tno) TXTY))
(cons 11 (list (- TXTX tno) TXTY))
(cons 40 ht)
(cons 50 0.0) (cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 son)
(cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list TXTX TXTY))
(cons 11 (list TXTX TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 soe) (cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (+ TXTX encw) TXTY))
(cons 11 (list (+ TXTX encw) TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "text")
(cons 1 sol) (cons 7 "Gen-Text")
(cons 8 "Coordinate Table")
(cons 10 (list (+ TXTX encw encw) TXTY))
(cons 11 (list (+ TXTX encw encw) TXTY))
(cons 40 ht)
(cons 50 0.0)
(cons 72 4)
)
)
(entmake
(list
(cons 0 "line")
(cons 8 "Coordinate Table")
(cons 10 (list (- TXTX (+ ten nocw)) (- TXTY ht)))
(cons 11 (list (+ TXTX ten encw encw) (- TXTY ht)))
)
) ;; horizontal lines
(setq hl (entlast)) ; set hl as last horizontal line
(setq CNT (+ CNT 1))
) ;repeat
(setq ly (caddr (assoc 10 (entget hl)))) ;set last y value
;; place easting & northing vertical table lines
(entmake
(list
(cons 0 "line")
(cons 8 "Coordinate Table")
(cons 10 (list (- fx ten) (+ fy ht)))
(cons 11 (list (- fx ten) ly))
)
)
(entmake
(list
(cons 0 "line")
(cons 8 "Coordinate Table")
(cons 10 (list (+ fx ten) (+ fy ht)))
(cons 11 (list (+ fx ten) ly))
)
)
(entmake
(list
(cons 0 "line")
(cons 8 "Coordinate Table")
(cons 10 (list (+ fx (* 3 ten)) (+ fy ht)))
(cons 11 (list (+ fx (* 3 ten)) ly))
)
)
(entmake
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 8 "Coordinate Table")
(cons 90 4)
(cons 70 1)
(cons 10 (list (- fx (+ ten nocw)) (+ fy (* ht 4))))
(cons 10 (list (+ fx (+ ten encw encw)) (+ fy (* ht 4))))
(cons 10 (list (+ fx (+ ten encw encw)) ly))
(cons 10 (list (- fx (+ ten nocw)) ly))
)
) ; inner rectangle
(entmake
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 8 "Coordinate Table")
(cons 90 4)
(cons 70 1)
(cons 10 (list (- fx (+ ten nocw 1)) (+ fy (* ht 4) 1)))
(cons 10 (list (+ fx (+ ten encw encw 1)) (+ fy (* ht 4) 1)))
(cons 10 (list (+ fx (+ ten encw encw 1)) (- ly 1)))
(cons 10 (list (- fx (+ ten nocw 1)) (- ly 1)))
)
) ; outer rectangle
(command "erase" hl "")
) ; progn
) ;if
(command "redraw")
(princ)
) ; defun
;;-------------Main function to make List of points-----
(defun c:CRT (/ txtx txty len cord cords cnt sp ht code son soe sol sox soy soz so1 encw nocw ten tno lat hl ly fx fy)
(setvar "cmdecho" 0)
(setq temperr *error*)
(setq *error* trap3)
(setq CORDS nil LEN nil CNT 0) ;;resets coord list to nil
(princ (strcat "\n "))
(initget 1 "All Select")
(setq sel (strcase (getkword "\Select individual coordinate points or Select All (S or A): ")))
(if (= sel "SELECT") (setq SS (ssget '((2 . "crblk")))) (setq SS (ssget "X" '((2 . "crblk")))))
(command "UCS" "WORLD")
(while (/= SS nil) ;;;checks for nil selection
(setq LEN (sslength SS))
(repeat LEN
(setq SO0 (ssname SS CNT))
(setq CORD (cdr (assoc '10 (entget SO0)))) ;;;gets coords of point
(setq SOX (rtos (car CORD) 2 3)) ;;;strips off X coord
(setq SOY (rtos (cadr CORD) 2 3)) ;;;strips off Y coord
(setq SOZ (rtos (caddr CORD) 2 3)) ;;;strips off Z coord
(setq SO1 (entnext SO0)) ;;;gets attribute entity
(setq CODE (cdr (assoc '1 (entget SO1)))) ;;;strips off point code from attribute
(setq CORD (strcat CODE "," SOY "," SOX "," SOZ)) ;;;creates string of code,y,x,Z
(setq CORDL (list CORD)) ;;;converts into list
(if (= CORDS nil) (setq CORDS CORDL) (setq CORDS (append CORDL CORDS))) ;;;starts new list or adds to old
(setq CNT (+ CNT 1))
)
(setq SS nil) ;;;finishes loop
) ;while
(command "UCS" "P")
(if (/= (length CORDS) 0) (CRTable))
(setq *error* temperr)
(prompt "\n Coordinate Table is Placed\n © Bijoy Manoharan 2016")
(princ)
) ;defun
;;------------- end Main function --------------------
(alert "-------------------------- Coordinates with Table ---------------------------
\n Commands
\n Command CN ( For Increment Coordinate Point Number )
\n Command CSN( For Increment Coordinate Point Sub Number )
\n Command RES( To Reset Prefix Text Variable )
\n Command CRT( To Place Coordinate Table )
\n Steps
\n 1. Enter appropriate Scale (in A1) to be drawn
\n 2. Enter Prefix Text
\n 3. Enter Starting Number
\n 4. Pick Text Location
\n 5. After Placing Coordinate Points run Command CRT to place table
\n 6. Type A to select all coordinate points
\n 7. Type S to select individual coordinate points
\n 8. Pick a point to place Coordinate Table.")
（setvar’dimzin 0）
尝试-->LM:rtos
页:
[1]