[编程交流] LISP for creating text label (

[color="darkgreen"];|argument - Type          ---------------------------pt        - specified point  bp        - Base coordinates n        - scale, number    mX      - max X, number    mY        - max Y, number    $        - suffix, string   -------------------------  Return value:                   A string                   ---------------------------example        :                   (MAP-SHEET[color="red"]:[/color] '(409354.53 4937853.7) '(200000 5170000)  250000 60000 60000 nil)pt,'(409354.53 4937853.7) = specified point inside the required sheetbp, '(200000 5170000) = base coordinates of sheet at upper left corner, listn, 250000 = scale 1:10000                mX, 600000 = maximum X range of sheet        mY, 600000 = maximum Y range of sheet        $, nil = suffix of upper level sheetreturns: list, (suffix x y z )example call:(MAP-SHEET: pt bp 250000 600000 600000 nil)'("102-2" 418370.0 5.03597e+006 0.0)  |;[/color](defun [color="blue"][b]MAP-SHEET:[/b][/color] (pt bp n mX mY $ / ls d l p k) ;hanhphuc 20.12.2016 (if (setq ls '((250000 150000 100000)         (100000 60000 40000)         (50000 30000 20000)         (25000 15000 10000)         (10000 6000 4000)         (5000 3000 2000)         (2000 1200 800)         (1000 600 400)         (500 300 200)         )    l  (assoc n ls)    )   (progn (setq d  (mapcar '- pt bp)         ls (reverse (mapcar '+ '(1 -101) (mapcar ''((x y) (fix (/ x y))) d (cdr l))))         k  (mapcar '+ '(1 -1) (mapcar ''((x y) (fix (/ x y))) d (cdr l)))         k  (- (* (1+ (cadr k)) (/ mY (caddr l))) (car k))         %  (if        (or (> (abs (car d)) mX) (> (abs (cadr d)) mY) (minusp (car d)) (minusp (- (cadr d))))              "\rOut of range!!           "              (cond ($ (apply 'strcat (append (mapcar 'itoa (list (/ (car l) 1000) k)) (list "-" $))))                    ((vl-string-right-trim                       "-"                       (apply 'strcat                              (mapcar ''((x) (strcat (itoa x) "-")) (cons (/ (car l) 1000) (mapcar 'abs ls)))                              )                       )                     )                    )              )         )   (cons          (if (and % (/= % "\rOut of range!!           "))           (substr % (+ 2 (vl-string-search "-" %)))           ""           )         pt         )   ) ; progn   ) )

[color="darkgreen"];|example call:(map-label     "250K" ; str - message for sheet selection     '(200000.00  5170000.00 ) ; p1 - coordinates of sheet at upper left corner     1 ; f - repeating flag, 1 or 0     7000 ; text height     250000 ; scale factor 1:250000     600000 ; maximum X range of sheet     600000 ;maximum Y range of sheet             nil ; suffix of upper level sheet or N/A     )|;[/color](defun [color="blue"]map-label[/color] (str p1 f h n mX mY $ / l p2) (prompt (strcat "\nSpecify point " str "\n"))   (eval     (cons (if        (zerop f)      'progn      'while      )    '((while       (and (setq p (grread t 1 0)) (= 5 (car p)) (setq p2 (cadr p)))       (setq l ([color="blue"]MAP-SHEET:[/color] p2 p1 n mX mY $))       (if        (/= (car l) "")        (princ (strcat "\rSHEET " (setq str (itoa (/ n 1000))) "-" (car l) "       "))        (prompt "\rOut of range!          ")        )       )      (entmakex       (mapcar ''((a b) (cons a b)) '(0 1 10 40 50)        (list "TEXT" (strcat str "-" (car l)) (trans (cdr l) 1 0)         h (angle '(0. 0. 0.) (getvar 'ucsxdir))         )        )       )      )    )     )  (car l) )

[color="green"];with '(200000.00  5170000.00 ) known base coordinates without user picking[/color](defun c:map250K nil (if (= (getvar 'dwgname) "250k.dwg")   ([color="blue"]map-label[/color] "Sheet [M 1:250000]"    [color="red"] '(200000.00  5170000.00 )[/color] [color="green"];known upper left corner[/color]     1     7000     [color="red"]250000[/color]     600000     600000     nil)   (alert "\nInvalid working drawing!")   ) (princ) )[color="green"];if corner unknown, user pick example[/color](defun c:map50K        (/ pt) (if (= (getvar 'dwgname) "50k (25k-5k, 10k, 2k-1k-0.5k).dwg")   (and (setq pt (getpoint "\nPick Upper Left corner of sheet - [M 1: 50000 ]")) ([color="blue"]map-label[/color] "Sheet [M 1:50000]"   pt 1 2000 [color="red"]50000[/color] 600000 600000 nil) )   (alert "\nInvalid working drawing!")   ) (princ) )[color="green"];if known base point of 2 different sheets[/color](defun c:map10K        nil (Alert "\nSelect sheet in [M 1:50000] \nthen specify label insertion point in [M 1:10000].. ") (if (= (getvar 'dwgname) "50k (25k-5k, 10k, 2k-1k-0.5k).dwg")   ([color="blue"]map-label[/color] "Sheet [M 1:10000]"     [color="red"]'(928187.08 5276613.90)[/color] [color="green"];for sheet 1:10K[/color]     1     500     [color="red"]10000[/color]     30000     20000     ([color="blue"]map-label[/color] "Sheet [M 1:50000]"[color="red"]'(200000.00  5170000.00 )[/color] [color="green"];for sheet 1:50k [/color]02000[color="red"]50000[/color]600000600000nil))      (alert "\nInvalid working drawing!")   ) (princ) )