[编程交流] LISP缺少一行。

(DEFUN C:COMEDARRAY ( / OLDL NOR NOC CEB CEP )
 (SETQ OLDL (GETVAR "CLAYER"))
 (COMMAND "_LAYER" "SET" "ELEC-CE" "")
 (SETQ NOR (GETINT "\nENTER NUMBER OF COMED ROWS: "))
 (SETQ NOC (GETINT "\nENTER NUMBER OF COMED COLUMNS: "))
 (setq CEP1 (getpoint "\nPICK INSERT POINT FOR BLOCK: "))
 (COMMAND "_INSERT" "S:\\LightSett\\LISP FILES\\LISP USED BLOCKS\\COMED PROFILE.DWG" CEP1 "" "" "")
 (SETQ CEB (ENTLAST))
 (COMMAND "_ARRAY" CEB "" "R" NOR NOC 0.6667 0.3333)
 (SETQ CEP (SSGET '((0 . "INSERT"))))
 (COMMAND "_MOVE" CEP "" CEP1 (cons (- (CAR CEP1) (/ (* NOC 0.3333) 2)) (CDR CEP1)))
 (COMMAND "_MOVE" CEP "" CEP1 (LIST (CAR CEP1) (- (CADR CEP1) (* NOR 0.6667)) (CADDR CEP1)))
 (command "layer" "set" OLDL "")
 (PRINC)
 )

(defun c:comedarray ( / oldl nor noc ceb cep )
 (if (and
(setq nor (cond ((getint (strcat "\nEnter number of comed rows: " (itoa (setq nor (cond ( nor ) ( 1 )))) ))) ( nor )))
(setq noc (cond ((getint (strcat "\nEnter number of comed columns: " (itoa (setq noc (cond ( noc ) ( 1 )))) ))) ( noc )))
(setq cep1 (getpoint "\npick insert point for block: "))
)
   (progn
     (if (vl-file-directory-p "s:\\lightsett\\lisp files\\lisp used blocks")
(progn
  (setq oldl (getvar "clayer"))
  (mapcar '(lambda ( a b c d ) (MakeLayer a b "Continuous" c T 0 d))
          '("ELEC-CE")
          '( 1 )
          '( 0.09 )
          '("Elect" "" )
          )
  (setvar "clayer" "ELEC-CE" )
  (vl-cmdf "_.-insert" "s:\\lightsett\\lisp files\\lisp used blocks\\comed profile.dwg" cep1 "1" "1" "0")                ; insert block
  (setq ceb (entlast))
  (vl-cmdf "_array" ceb "" "r" nor noc 0.6667 0.3333)
  (setq cep (ssget "x" (list (cons 0 "INSERT") (cons 2 "comed profile"))))
  (vl-cmdf "_move" cep "" cep1 (cons (- (car cep1) (/ (* noc 0.3333) 2)) (cdr cep1)))
  (vl-cmdf "_move" cep "" cep1 (list (car cep1) (- (cadr cep1) (* nor 0.6667)) (caddr cep1)))
  (setvar "clayer" oldl )
  ))
     ))
 (princ)
 )
(defun MakeLayer ( name colour linetype lineweight willplot bitflag description )
   ;; (MakeLayer name colour linetype lineweight willplot bitflag description )
   ;; Specifications:
   ;; Description        Data Type        Remarks
   ;; -----------------------------------------------------------------
   ;; Layer Name          STRING          Only standard chars allowed                        
   ;; Layer Colour        INTEGER         may be nil, -ve for Layer Off, Colour < 256        
   ;; Layer Linetype      STRING          may be nil, If not loaded, CONTINUOUS.        
   ;; Layer Lineweight    REAL            may be nil, 0 <= x <= 2.11                        
   ;; Plot?               BOOLEAN         T = Plot Layer, nil otherwise                
   ;; Bit Flag            INTEGER         0=None, 1=Frozen, 2=Frozen in VP, 4=Locked        
   ;; Description         STRING          may be nil for no description                
   ;; Function will return list detailing whether layer creation is successful.        
   ;; © Lee Mac 2010
 
 (regapp "AcAecLayerStandard")
 (or (tblsearch "LAYER" name)
   (entmake
     (append
       (list
         (cons 0        "LAYER")
         (cons 100        "AcDbSymbolTableRecord")
         (cons 100        "AcDbLayerTableRecord")
         (cons 2        name)
         (cons 70        bitflag)
         (cons 290        (if willplot 1 0))
         (cons 6        (if (and linetype (tblsearch "LTYPE" linetype)) linetype "CONTINUOUS"))
         (cons 62        (if (and colour (< 0 (abs colour) 256)) colour 7))
         (cons 370        (fix (* 100 (if (and lineweight (<= 0.0 lineweight 2.11)) lineweight 0.0))))
  )
(if description (list (list -3 (list "AcAecLayerStandard" (cons 1000 "") (cons 1000 description)))))
))))

(command "_.move" ss "" "_non" pt1 "_non" pt2)