[编程交流] LISP，替换l的智能方法

 ; Move linetype <LBR> to layer <LBR>
 (setq Layer "LBR")
 (if (tblsearch "LAYER" Layer)
   (if (setq LSelect (ssget "_X" '((6 . "LBR"))))
     ((lambda (j / sn)
        (while
          (setq sn (ssname LSelect (setq j (1+ j))))
           (entupd
             (cdr
               (assoc
                 -1
                 (entmod (append (entget sn)
                                 (list '(6 . "BYLAYER")
                                       '(370 . -1)
                                       '(62 . 256)
                                       (cons 8 Layer)
                                 )
                         )
                 )
               )
             )
           )
         )
       )
       -1
     )
   )
   (princ (strcat "\n Layer name <" Layer "> is not found <!>"))
 )
 (if LSelect
   (princ (strcat "\n <"
                  (itoa (sslength LSelect))
                  "> "
                  (if (> (sslength LSelect) 1)
                    "objects"
                    "object"
                  )
                  " moved to layer <"
                  Layer
                  ">"
          )
   )
 )
 (princ)
)

([color=BLUE]defun[/color] c:addbrackets ( [color=BLUE]/[/color] ang blk dis enx inc pt1 pt2 sel )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] blk (LM:ssget [color=MAROON]"\nSelect Bracket Block: "[/color] '([color=MAROON]"_+.:E:S"[/color] ((0 . [color=MAROON]"INSERT"[/color])))))
           ([color=BLUE]setq[/color] sel (LM:ssget [color=MAROON]"\nSelect Lines for Brackets: "[/color] '(((0 . [color=MAROON]"LINE"[/color])))))
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] blk ([color=BLUE]assoc[/color] 2 ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] blk 0))))
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] inc ([color=BLUE]sslength[/color] sel))
               ([color=BLUE]setq[/color] enx ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] inc ([color=BLUE]1-[/color] inc))))
                     pt1 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 enx))
                     pt2 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 11 enx))
                     ang ([color=BLUE]angle[/color] pt1 pt2)
                     dis ([color=BLUE]distance[/color] pt1 pt2)
               )
               ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]<[/color] ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.0) ang) ([color=BLUE]<=[/color] ang ([color=BLUE]/[/color] ([color=BLUE]*[/color] 3.0 [color=BLUE]pi[/color]) 2.0)))
                   ([color=BLUE]setq[/color] ang ([color=BLUE]+[/color] ang [color=BLUE]pi[/color]))
               )
               ([color=BLUE]entmake[/color]
                   ([color=BLUE]list[/color] '(0 . [color=MAROON]"INSERT"[/color]) blk
                       ([color=BLUE]cons[/color] 10
                           ([color=BLUE]polar[/color]
                               ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]/[/color] ([color=BLUE]+[/color] a b) 2.0)) pt1 pt2)
                               ([color=BLUE]-[/color] ang ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.0))
                               ([color=BLUE]/[/color] dis 4.0)
                           )
                       )                               
                       ([color=BLUE]cons[/color] 50 ang)
                       ([color=BLUE]cons[/color] 41 dis)
                       ([color=BLUE]cons[/color] 42 dis)
                       ([color=BLUE]cons[/color] 43 dis)
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)
[color=GREEN];; ssget  -  Lee Mac[/color]
[color=GREEN];; A wrapper for the ssget function to permit the use of a custom selection prompt[/color]
[color=GREEN];;[/color]
[color=GREEN];; Arguments:[/color]
[color=GREEN];; msg    - selection prompt[/color]
[color=GREEN];; params - list of ssget arguments[/color]
([color=BLUE]defun[/color] LM:ssget ( msg params [color=BLUE]/[/color] sel )
   ([color=BLUE]princ[/color] msg)
   ([color=BLUE]setvar[/color] 'nomutt 1)
   ([color=BLUE]setq[/color] sel ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]ssget[/color] params))
   ([color=BLUE]setvar[/color] 'nomutt 0)
   ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] sel)) sel)
)
([color=BLUE]princ[/color])

(defun c:Bracket (/ BracketStart                   BracketEnd                   LegLength                   FirstLeg                   FirstMiddleLeg                   MidPoint                   LastMiddleLeg                   LastLeg                   PointList                   ConstantSide                   BracketAngle                   BracketEnd                   BracketLength                   FirstAngle                   LastAngle                   CurrentSettings  )  ;; Default Values (setq Bracket:LegLength 4.0CurrentSettings (mapcar '(lambda (x) (cons x (getvar x))) '("cmdecho" "clayer" "plinewid")) ) (setvar "CMDECHO" 0) (if    (if (setq lSet (ssget "_X" '((6 . "LBR"))))      (sssetfirst nil lSet)   )      (progn ;(1)     (setq inc (sslength lSet))     (repeat inc       (setq enx (entget (ssname lSet (setq inc (1- inc))))             ;pt1 (cdr (assoc 10 enx))             ;pt2 (cdr (assoc 11 enx))             BracketEnd (cdr (assoc 10 enx))             BracketStart (cdr (assoc 11 enx))       )              ; Begin Main Function       (if          (and           ;(setq BracketStart '(643.75 320.00 00.00))           ;(setq BracketEnd '(31.25 320.00 00.00))                      ;(setq BracketStart (getpoint "\nEnter start point: "))           ;(setq BracketEnd (getpoint "\nEnter end point: "))         )                  (progn           (setq ConstantSide   0.707106781185                 LegLength      Bracket:LegLength                 BracketLength  (distance BracketStart BracketEnd)                 BracketAngle   (angle BracketStart BracketEnd)                 FirstAngle     (+ BracketAngle (* pi (/ 45 180.0)))                 LastAngle      (+ BracketAngle (* pi (/ 135 180.0)))                 FirstLeg       (polar BracketStart FirstAngle LegLength)                 LastLeg        (polar BracketEnd LastAngle LegLength)                 FirstMiddleLeg (polar FirstLeg                                       BracketAngle                                       (- (/ (distance FirstLeg LastLeg) 2.0)                                          (* LegLength ConstantSide)                                       )                                )                 MidPoint       (polar FirstMiddleLeg FirstAngle LegLength)                 LastMiddleLeg  (polar LastLeg                                       (angle BracketEnd BracketStart)                                       (- (/ (distance FirstLeg LastLeg) 2.0)                                          (* LegLength ConstantSide)                                       )                                )                 PointList      (list BracketStart                                      FirstLeg                                      FirstMiddleLeg                                      MidPoint                                      LastMiddleLeg                                      LastLeg                                      BracketEnd                                )           )                        (if (tblsearch "LAYER" "TEXT")             (command "_.layer" "_Thaw" "Text" "_Set" "Text" "")             (command "_.layer" "_Make" "Text" "")           )                        (if             (and               Bracket:Type               (= (strcase Bracket:Type) "LINE")             )             (command "_.line")             (progn               (setvar "PLINEWID" 0)               (command "_.pline")             )           )                        (foreach n PointList             (command "_non" n)           )           (command "")           (mapcar '(lambda (x) (setvar (car x)(cdr x))) CurrentSettings)         )       ) ; End Main Function     )   ) ;End Progn (1) ) (sssetfirst nil nil)  (princ))