跪求 各位版主帮我完善这个均匀布置图块程序

edsion24

这个程序 在UCS 世界里使用正常  是一个均匀布置的 命令
可是在UCS变化的时候  他一用就会飞。。。 跪求哪位高手 给完善一下 在UCS 变化之后 还能正常使用


(defun sets-err (s)                    ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
(if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
)
(e-set)
(setq *error* olderr)                 ; Restore old *error* handler
(princ)
)

(defun sset(/ pt2 pt3  q w )                ;-----single setting-----
   ( while (/= p1 nil)
            (command "setvar" "osmode" 32)
     (setq p2 (getcorner p1 " \n点取右上角: "))
            (command "setvar" "osmode" 0)
     (setq q (+ (car p1) (car p2)))
     (setq w (+ (cadr p1) (cadr p2)))
     (setq p3 (list (/ q 2.0) (/ w 2.0)))
     (command "copy" enty "" basp p3)
            (command "setvar" "osmode" 32)
     (setq p1 (getpoint" \n点取左下角: "))
            (command "setvar" "osmode" 0)
   )
     )
;-------------------------------------------------------------------------
   (defun enta ()
   (if (< nl 1) (setq nl 1))
   (if (< nw 1) (setq nw 1))
   (cond
   ((and (/= nl 1) (/= nw 1)) (command "array" "L" "" "r" nw nl dw dl))
   ((= nl 1) (command "array" "L" ""  "r"  nw nl dw))
   ((= nw 1) (command "array" "L" "" "r"  nw nl dl))
           )
           )
;--------------------------------------------------------------------------
           (defun getna ()
           (setq ll (/ l 1000))
           (setq ww (/ w 1000))
           (setq a (* ll ww))
           (setq n (/ a aa))
           (setq nw (sqrt (/ (* w n) l)))
           (setq nl (sqrt (/ (* l n) w)))
           (if (> nl nw)
              (progn (setq nl (fix (+ nl 0.5)))
                     (setq nw (fix (+ (/ n nl) 0.5 )))
              )
              (progn (setq nw (fix (+ nw 0.5)))
                     (setq nl (fix (+ (/ n nw) 0.5 )))
              )
           ) )
  ;-----------------------------------------------------------------------
          (defun getnd ()
          (if (/= dl nil) (setq nl (fix (+ (/ l dl) 0.5)))
                          (setq nl 1))
          (if (/= dw nil) (setq nw (fix (+ (/ w dw) 0.5)))
                          (setq nw 1) )
          )



(defun c:BD (/ swha  a p1 p2  nl nm dl dw endp ent enty entp wpl uap)
     (setq olderr *error* )
     (setq *error* sets-err)
     (initi)
     (initget "A D N S L")
     (setq swha (getkword "面积A..距离D..数目N..单个S..灯具L <S>: "))
     (if (not swha) (setq swha "S"))
     (cond
      ((= swha "A") (progn (initget 7) (setq aa (getreal "\n单位面积: "))))
      ((= swha "L") (progn (setq wpl (getreal "\n每个灯具瓦数: "))
                    (setq uap (getreal "\n每平米瓦数: "))
                    (setq aa (/ wpl uap))
                    (setq swha "A")
                    ))
      ((= swha "D") (progn
                      (setq dl (getreal "\n列距 (|||): "))
                      (setq dw (getreal "\n行距 (===): "))))
      ((= swha "N") (progn (setq nl (getint "\n列数 (|||) <2>: "))
                      (setq nw (getint "\n行数 (===) <2>: "))
                      (if (not nl) (setq nl 2))
                      (if (not nw) (setq nw 2))))
        );end cond
            (setq entp (entsel "\n点取设备: "))
              (while (not entp)
              (setq entp (entsel "\n没选上!请再点取设备... "))
              )
            (setq enty (car entp))
            (setq basp (cdr (assoc 10 (entget enty))))
            (command "setvar" "osmode" 32)
            (initget 1)
            (setq p1 (getpoint "\n点取左下角: "))
            (command "setvar" "osmode" 0)
            (if (= swha "S") (sset))
        (if (/= swha "S") (progn
            (command "setvar" "osmode" 32)
            (initget 1)
            (setq p2 (getcorner p1 "\n点取右上角: "))
            (command "setvar" "osmode" 0)
            (setq l (- (car p2) (car p1)))
            (setq w (- (cadr p2) (cadr p1)))
            (cond
              ((= swha "A") (getna))
              ((= swha "D") (getnd))
            )
          ;  (command "setvar" "osmode" *osn)
            (setq dl (/ l nl))
            (setq dw (/ w nw))
            (setq endp (list (+ (car p1) (/ dl 2)) (+ (cadr p1) (/ dw 2))))
            (command "copy" enty "" basp endp)
            (enta)
            ));end if
        (e-set)
       (setq *error* olderr)
      );end defun

198526

有一个简单的方法，你在程序前记录当前UCS的坐标值，再把UCS设为世界坐标。在程序出错或程序结束后把UCS坐标设回开始记录的坐标就行了

198526

系统变量 ucsorg 存储当前空间当前视口的当前坐标系原点。该值总是以世界坐标形式保存。

LIULISHENG

hdlyt11

命令: BD
Error: no function definition: INITI无函数定义: E-SET

stonedesign

缺少函数    为函数一部分代码没法出来的