日志
类似天正电气均匀布灯的程序
热度 1 |||
;;; LPLACE.LSP made by piggy
;;;
;;; DESCRIPTION
类似天正电气均匀布灯的程序
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=64645
;===============================================================================
;;; 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))
