[编程交流] 图层和标注Lisp

(defun c:blk (/ Ent BlkEnt blkNme )
 (setq Ent (car(entsel "\n Select a Block: "))
BlkEnt (entget Ent)
BlkNme (cdr (assoc 2 BlkEnt))
)
   (vl-cmdf "_.-layer" "_m" BlkNme "ltype" "continuous" "" "color" "red" "" "")
 (setvar "clayer" BlkNme)
 (princ)
 )
        

(defun c:Blk2lay ( / ss )
 ;; © Lee Mac 2010
 (if (setq ss (ssget '((0 . "INSERT"))))
   (
     (lambda ( i / e done )
       (while (setq e (ssname ss (setq i (1+ i))))
         (if (not (member (cdr (assoc 2 (entget e))) done))
           (progn
             (entmake
               (list
                 (cons 0 "LAYER")
                 (cons 100 "AcDbSymbolTableRecord")
                 (cons 100 "AcDbLayerTableRecord")
                 (assoc 2 (entget e))
                 (cons 70 0)
               )
             )
             (setq done (cons (cdr (assoc 2 (entget e))) done))
           )
         )
         (entupd
           (cdr
             (assoc -1
               (entmod
                 (subst
                   (cons 8 (cdr (assoc 2 (entget e))))
                   (assoc 8 (entget e))
                   (entget e)
                 )
               )
             )
           )
         )         
       )
     )
     -1
   )
 )
 (princ)
)
     

;SETOUT3.LSP
; program to draw setout details as a co-ord list
; with co-ords to two points
; 29/7/01 by alan
(setvar "menuecho" 0)
(setvar "SNAPMODE" 0)
(COMMAND "STYLE" "MYDEFAULT" "ISO3098b" 0.0 1.0 0.0 "N" "N" "N")
(setq oldangbase (getvar "angbase"))
(setq oldangdir (getvar "angdir"))
(setq oldaunits (getvar "aunits"))
(setvar "angbase" 0.0)
(setvar "angdir" 0)
(setvar "aunits" 3)
(SETQ SETSC (GETREAL "\nWhat is overall scale 1 ?  "))
(SETQ TXTHT (* 1.75 setsc)) ;CHANGE TO ASK FOR FINAL PLOT SCALE   
(while 
(SETVAR "OSMODE" 1)
(setq pt1 (getpoint "\nPick 1st point, press <cr> to exit"))
(setq pt2 (getpoint "\nPick next point, press <cr> to exit"))
(SETQ DIST (DISTANCE PT1 PT2))
(SETQ DISTMID (/ DIST 2.0))
(SETQ ANG (ANGLE PT1 PT2))
(setq pt3 (polar pt1 ANG DISTMID))
(setq pt3 (polar pt3 (+ ang 1.5707) 1.5))
(SETQ BLOCKLEN (RTOS DIST 2 2))
(SETVAR "OSMODE" 0)
(command "text" "MC" pt3 txtht ANG BLOCKLEN) 
(setq flip (getstring "\nFlip text 180 press f  "))
(if (or (= flip "f")(= flip "F"))
(command "rotate" "l" "" pt3 3.14159)
)
)                                                   ; end while
(setvar "angbase" oldangbase )
(setvar "angdir" oldangdir)
(setvar "aunits" oldaunits)
(setq pt1 nil
     pt2 nil
     pt3 nil
     pt4 nil
     pt5 nil
     pt6 nil
     stpt nil
     ans nil
)
(princ)