[分享]类似天正电气均匀布灯的程序

jadekylin

总共两个lsp，lplace.lsp,undo.lsp，只能在R14里运行，不能在2007里运行，哪位能否帮忙修改一下！多谢！

guankuiwu

受益匪浅，但无LIGHT.INI。能否分享一下？

BDYCAD

;;;  LPLACE.LSP made by piggy
;;;
;;;  DESCRIPTION
;;;     Place and connect lights
;;;
;;;  DATE: 12/18/98;
;;;
;;;  HISTORY: NONE
;----------------------------------------------------------------------------
;  GLOBALS:
;     light_layer -- layer of light
;     wire_layer  -- layer of wire
;----------------------------------------------------------------------------
(defun lplace(/ m n insblk insang inspt olyr)
  (if (and (not undo_init) (equal -1 (load "undo.lsp" -1)))
      (progn (alert "Error:\n   Cannot find UNDO.LSP.") (exit))
  );if
;;;  (err_init '("CMDECHO" "OSMODE" "BLIPMODE" "REGENMODE") T '(setq l_s nil))
;;;  (var_set '(("CMDECHO" 0) ("OSMODE" 0) ("BLIPMODE" 0) ("REGENMODE" 0)))
  (setvar "osmode" (logior (getvar "osmode") 16384));关辅捉
  ;; Get information
 
  (cond ((numberp light_scale)) (T (setq light_scale 1)))
  (cond (light_layer) (T (setq light_layer (getvar "CLAYER"))))
       
  (prompt (strcat "\n默认图层：\"" light_layer "\"。" ))
  (prompt (strcat "\n默认比例：\"" (rtos light_scale 2 2) "\"。"))
  (cond
    ((= (cdar (laychk light_layer)) "No")
      (laychk (setq light_layer (getvar "CLAYER")))
      (prompt (strcat "\n图层被设为当前层：\"" light_layer "\"。" ))
    )
  ); cond
  
  (while (not insblk)
    (initget "Layer Scale Name")
    (setq insblk (getkword "\n图层 L / 比例 S / 图块名 N："))
    (cond
      ((= "Scale" insblk)
       (initget 6)
       (setq light_scale
         (cond ((getreal (strcat "\n请输入图块比例：<"
                                (rtos light_scale 2 2)
                                "> ")))
               (T light_scale)
         ); cond
         insblk nil
       ); setq
      )
      ((= "Layer" insblk)
       (setq olyr light_layer insblk nil)
       (setq light_layer (getstring (strcat "\n请选择图层：<"
                                            light_layer "> ")))
       (cond ((= light_layer "") (setq light_layer olyr)))
       (cond ((= (cdar (laychk light_layer )) "No")
              (setq light_layer olyr)
              (prompt (strcat "\n图层仍为：\"" light_layer "\"。" )))
       ); cond
      )
      (T
       (cond
         ((= (getvar "INSNAME") "")
           (setq insblk (getstring "\n请输入图块名："))
           (cond ((tblsearch "BLOCK" insblk) (setvar "INSNAME" insblk))
                 (T (setq insblk nil))); cond
         )
         (T
           (setq insblk (getstring (strcat "\n请输入图块名：<"
                                            (getvar "INSNAME") "> ")))
           (cond ((= insblk "") (setq insblk (getvar "INSNAME")))); cond
           (cond ((tblsearch "BLOCK" insblk) (setvar "INSNAME" insblk))
                 (T (setq insblk nil))); cond
         )
       ); cond
       (cond (insblk) (T (prompt "\n无效的图块！"))); cond
      )
    ); cond
  ); while      
 
  (setq insang (getangle "\n请输入图块的角度：<0> "))
  (cond ((not insang) (setq insang 0)))
  (setq inspt (gettrs))
 
  (setq n 0) 
  (while (< n (length inspt))
    (setq m 0)
    (while (< m (length (car inspt)))
      (apply '(lambda (iname ilayer ipoint iscale iangle)
                (entmake (list (cons 0 "INSERT")
                               (cons 2 iname)
                               (cons 8 ilayer)
                               (cons 10 ipoint)
                               (cons 41 iscale)
                               (cons 42 iscale)
                               (cons 43 iscale)
                               (cons 50 iangle)
                         )
                ); entmake
              ); lambda
             (list insblk light_layer (nth m (nth n inspt)) light_scale insang)   
       ); apply
      (setq m (1+ m))
    ); while
    (setq n (1+ n))
  ); while
 
  (initget 1 "Yes No")
  (cond ((= "Yes" (getkword "\n是否需要连线 ？(Y/N) "))
         (connect insblk insang light_scale inspt))
  ); cond

  (layres)
;;;  (err_restore)
  (princ)
); defun lplace

(defun gettrs(/ ulpt lrpt row col inspt deltax deltay n)
  (initget 1)
  (setq ulpt (getpoint "\n请选择右上角："))
  (initget 1)     
  (setq lrpt (getcorner ulpt "\n请选择左下角："))
  (grdraw ulpt (list (nth 0 lrpt) (nth 1 ulpt)) 2 1)
  (grdraw (list (nth 0 lrpt) (nth 1 ulpt)) lrpt 2 1)
  (grdraw lrpt (list (nth 0 ulpt) (nth 1 lrpt)) 2 1)
  (grdraw (list (nth 0 ulpt) (nth 1 lrpt)) ulpt 2 1)

  (initget 7)
  (setq row (getint "\n请输入行数："))
  (initget 7)
  (setq col (getint "\n请输入列数："))
  (setq deltax (/ (- (car lrpt) (car ulpt)) col)
        deltay (/ (- (cadr ulpt) (cadr lrpt)) row)
  ); setq

  ;; Try to find the transformer of points
 
  (repeat col
  ;  new_first_row = (cons ((old_point) - deltax) old_first_row
    (cond (inspt
            ((lambda (x)
             (setq inspt (subst (cons (list (- (nth 0 (car x)) deltax)
                                            (nth 1 (car x))
                                            (nth 2 (car x))) x)
                                 x
                                inspt))
             ); lambda
             (car inspt))
          )
          (T
             (setq inspt (list (list (list (- (nth 0 lrpt) (/ deltax 2.0))
                                           (- (nth 1 ulpt) (/ deltay 2.0))
                                           (nth 2 ulpt))))); setq
          )
    ); cond
 
    (setq n 0)
    (while (< n (1- row))
    ;  new_row_information = (cons new_list old_row_information)
    ;                        or (subst new_row_information old_row_information)
    ;  new_list = (car old_row_information) - deltay
   
      (apply
        '(lambda (x y)
           (cond ( y
                   (setq inspt (subst (cons (list (nth 0 (car x))
                                                  (- (nth 1 (car x)) deltay)
                                                  (nth 2 (car x))) y)
                                      y
                                      inspt))
                 )
                 (T (setq inspt (append inspt (list (cons (list (nth 0 (car x))
                                                                (- (nth 1 (car x)) deltay)
                                                                (nth 2 (car x)) ) y))))
                 )
           ); cond
         ); lambda
         (list (nth n inspt) (nth (1+ n) inspt))
      )
      (setq n (1+ n))
    ); while 
  ); repeat
  inspt
); defun gettrs

(defun turntrs(otrs / ntrs m n)
  (setq n 0)
  (while (< n (length otrs))
    ((lambda (x)
      (setq m (1- (length x)))
      (while (>= m 0)
        (cond
          (ntrs
            ((lambda (y)
              (if y
                (setq ntrs (subst (cons (nth m x) y)
                                  y
                                  ntrs))
                (setq ntrs (append ntrs (list (cons (nth m x) y))))
              ); if
             ); lambda
             (nth (- (length x) m 1) ntrs)      ; new row information
            )
          )
          (T (setq ntrs (list (list (nth m x)))))
        ); cond
        (setq m (1- m))
      ); while
     ); lambda
     (nth n otrs)
    )
    (setq n (1+ n))
  ); while
  ntrs
); defun turntrs

(defun connect(insblk insang inscale inspt / fp blkinf flag temp ppair hor m n offset ) 
  ; fetch available information of blocks
  ((lambda (f)
     (cond
       (f
         (setq fp (open f "r") temp (read-line fp))
         (while (and temp (not blkinf))
           ((lambda(x)
              (if (and (listp x) x)
                (if (= (strcase (cdr (assoc 0 x))) (strcase insblk))
                    (setq blkinf x))
              ); if
            ); lambda
            (read temp)
           )
           (setq temp (read-line fp))
         ); while
         (close fp)
       )
       (T (alert "无法打开文件 \"LIGHT.INI\" ！"))
     ); cond   
   ); lambda
   (findfile "LIGHT.INI")
  )
 
  (cond
    (blkinf
      (cond (wire_layer) (T (setq wire_layer (getvar "CLAYER"))))
      (prompt (strcat "\n默认图层：\"" wire_layer "\"。" ))
      (cond
        ((= (cdar (laychk wire_layer)) "No")
          (laychk (setq wire_layer (getvar "CLAYER")))
          (prompt (strcat "\n图层被设为当前层：\"" wire_layer "\"。" ))
        )
      ); cond
  
      (while (not flag)
        (initget 1 "Layer Hor Ver")
        (setq flag (getkword "\n图层 L / 垂直 V / 水平 H："))
        (cond
          ((= "Layer" flag)
           (setq temp wire_layer flag nil)
           (setq wire_layer (getstring (strcat "\n请选择图层：<"
                                                wire_layer "> ")))
           (cond ((= wire_layer "") (setq wire_layer temp)))
           (cond
             ((= (cdar (laychk wire_layer )) "No")
               (setq wire_layer temp)
               (prompt (strcat "\n图层仍为：\"" wire_layer "\"。" ))
             )
           ); cond
          )
          ((= "Hor" flag) (setq hor T))
          ((= "Ver" flag) (setq inspt (turntrs inspt)) (setq hor nil))
        ); cond
      ); while      
     
      (setq offset '(1 2 3 4))
      (repeat (fix (+ (/ (* insang 2) pi) 0.1))     ; Ajust offset according
        (setq offset (reverse (cdr (reverse (cons (last offset) offset)))))  ; to angle
      ); repeat 

      (setq offset
        (mapcar
          '(lambda (x)
             (cdr (assoc x blkinf))
           ); lambda
           (cond (hor (list (nth 0 offset) (nth 2 offset)))
                 (T (list (nth 1 offset) (nth 3 offset)))) ; cond
        ); mapcar
      ); setq
      (setq offset (list (* inscale (nth 0 offset)) (* -1 inscale (nth 1 offset))))
     
      ((lambda (y)
         (cond (hor (setq m 0)) (T (setq m 1))); cond
         (cond
           ((> (nth m (nth 0 y)) (nth m (nth 1 y)))
            (setq offset (mapcar '(lambda (x)
                                    (* -1.0 x)
                                  ); lambda
                                  offset
                         ); mapcar
            ); setq
           )
         ); cond
       ); lambda
       (car inspt))
     
      (mapcar
        '(lambda (x)
           (setq m 0)
           (while (< m (1- (length x)))
             (setq ppair 
               (mapcar
                 '(lambda (x dx)
                     (cond (hor (list (+ (nth 0 x) dx) (nth 1 x) (nth 2 x)))
                           (T (list (nth 0 x) (+ (nth 1 x) dx) (nth 2 x)))
                     ); cond
                  ); lambda
                  (list (nth m x) (nth (1+ m) x)) offset
               ); mapcar              
             ); setq
             (apply '(lambda (llayer spoint epoint)
                       (entmake (list (cons 0 "LINE")
                                      (cons 8 llayer)
                                      (cons 10 spoint)
                                      (cons 11 epoint)
                                )
                       ); entmake
                    ); lambda
                    (list wire_layer (car ppair) (cadr ppair))   
             ); apply
             (setq m (1+ m))
           ); while
         ); lambda
         inspt
      ); mapcar
    )
    (T (alert "该图块未被正确配置！"))
  ); cond
); defun connect

(defun c:lp() (lplace))
(defun c:lplace() (lplace))

jadekylin

多谢版主，这下我又可以很顺利的画图了！不知道是哪里修改了呢，能否告知啊？

BDYCAD

主要程序开头是那些置程序运行前的一些系统变量(关捕捉之类的)那一两个涵数,到了高版本就水土不服,所以改一下就好了.

fengsea

试了一下还不错，只是图块的选择如果增加框选为默认，其他三个选项为备选，使用上会更方便；还有捕捉关闭后框选区域会比较麻烦，而且步骤好像多了点；完成后亮选没有取消；希望能改进下

jadekylin

BDYCAD发表于2007-12-8 14:57:00主要程序开头是那些置程序运行前的一些系统变量(关捕捉之类的)那一两个涵数,到了高版本就水土不服,所以改一下就好了.

确实有这些问题，不过我不会编程，希望版主帮忙改改吧，再次多谢！

jxw221

楼主花了多长时间啊

jadekylin

jxw221发表于2007-12-15 20:57:00楼主花了多长时间

程序不是我编的，是同事编的，估计应该花了不少时间哦！

wj518_0

谢谢，受益很多啊

zhengchaunti

谢谢，受益很多啊