[求助]：请斑竹及各位高手指点！

lizhongf

;;;                                                                    ;
;;;  PANEL.LSP                                                         ;
;;;--------------------------------------------------------------------;
;;;       Function:  panel                                             ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  none                                              ;
;;;                                                                    ;
;;;          Usage: (panel)                                            ;
;;;--------------------------------------------------------------------;
(defun c:panel (/ pt0 pt1 pt2 pt3 pt4 pt10) ;; local variables pt0,pt1,pt2,pt3 and pt4 are declared
  (setq plen (getreal "\nPlease Input Panel Length(450,910,or 802.5 etc.): "))
  (setq        pt1 (getpoint "\nEnter the start point for the line: "))
    (setq pt0 (list (+ (car pt1) plen)  (- (cadr pt1) 12.5)))
    (princ )
    (command "_.layer" "new" "001-panel" "s" "001-panel" "c" "4" "" "")
    (command "_.rectang" pt1 pt0)
    (command "_.change" "l" "" "p" "la" "001-panel" "")
    (command "_.copy" "l" "" pt1 "@0,-52.5,0")        
    (setq pt2 (list (car pt1)  (- (cadr pt1) 52.5)))
    (command "_.pline" pt2 "@0,40" "@24,0" "@0,-40" "@-24,0" "@24,40" "")
    (command "_.change" "l" "" "p" "la" "001-panel" "")
    (if (> plen 450.0)
      (progn
         (setq pt3 (list (+ (car pt1) (/ plen 2)) (- (cadr pt1) 52.5)))
;;         (princ pt3)
         (setq pt10 (list (- (car pt3) 12) (cadr pt3)))
;;         (princ pt10)
         (command "_.pline" pt10 "@0,40" "@24,0" "@0,-40" "@-24,0" "@24,40" "")
         (command "_.change" "l" "" "p" "la" "001-panel" "")
      )
     )
      (setq pt4 (list (+ (car pt1)  (- plen 24)) (- (cadr pt1) 52.5)))   
      (command "_.pline" pt4 "@0,40" "@24,0" "@0,-40" "@-24,0" "@24,40" "")
      (command "_.change" "l" "" "p" "la" "001-panel" "")
      
)
---------------------------------------------------------------------------------
上面是代码，运行后发现很不稳定，中间的龙骨位置总是向左偏12，偶尔运行正常，具体出现的情况见附带的文件，请斑竹及各位高手指点！

xyp1964

修改如下：[php](load "xyp_lib")
;|加载通用函数(可在签名栏直接下载)
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
1.在acad.lsp中增加(load"xyp_lib")
2.在每个程序内增加(load"xyp_lib")
3.在command下，输入(load"xyp_lib")
4.在菜单.mnl中增加(load"xyp_lib")
5.将xyp_lib.vlx文件直接拽到cad屏幕
★通用函数下载地址：[/COLOR]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661|;

;;;龙骨绘制 lizhongf
(defun c:panel ()
  (cmdla0)
  (setq plen (UREAL 7 "" "\n长度(450,910,or 802.5 etc.)" plen))
  (while (setq pt1 (getpoint "\n起点<退出> : "))
    (setq pt0 (list (+ (car pt1) plen) (- (cadr pt1) 12.5)))
    (setvar "osmode" 0)
    (mkla "001-panel" 4)
    (command "_.rectang" pt1 pt0)
    (command "_.copy" "l" "" pt1 "@0,-52.5,0")
    (setq pt2 (list (car pt1) (- (cadr pt1) 52.5)))
    (pt-line pt2)
    (if        (>= plen 450.0)
      (progn
        (setq pt3 (list (+ (car pt1) (/ plen 2)) (- (cadr pt1) 52.5))
              pt5 (list (- (car pt3) 12) (cadr pt3))
        )
        (pt-line pt5)
      )
    )
    (setq pt4 (list (+ (car pt1) (- plen 24)) (- (cadr pt1) 52.5)))
    (pt-line pt4)
  )
  (cmdla1)
)
(defun pt-line (#pt)
  (command "_.pline" #pt "@0,40" "@24,0" "@0,-40" "@-24,0" "@24,40" "")
)[/php]

ohmylove

这么个小程序，不用加载什么通用函数库吧。
[php]
(defun c:panel ( / pt0 pt1 pt2 plen n str d old_cmdecho old_osmode)

  (setq        old_cmdecho (getvar "cmdecho"))
  (setq        old_osmode (getvar "osmode"))
  (setvar "cmdecho" 0)
        (setvar "osmode" 0)
       
        (setq        plen (getreal "\nPlease Input Panel Length(450,910,or 802.5 etc.): ")
              pt1 (getpoint "\nEnter the start point for the line: ")
              pt0 (list (+ (car pt1) plen) (- (cadr pt1) 12.5))
              pt2 (list (car pt1) (- (cadr pt1) 52.5))
        )
       
        (command "-layer" "m" "001-panel" "c" "4" ""        "")
        (command "_.rectang" pt1 pt0)
        (command "_.copy" "l" "" "0,-52.5" "")
        (command "_.pline" pt2 "@0,40" "@24,0" "@0,-40"        "@-24,0" "@24,40"        "")

        (if        (> plen 450.0)
                (setq n 2)
                (setq n 1)
        )
        (setq d (/ (- plen 24) n)
                                str (strcat (rtos d 2 2) ",0")
        )
       
        (repeat n
                (command "_.copy" "l" "" str "")
        )
       
        (setvar "osmode" old_osmode)
        (setvar "cmdecho" old_cmdecho)

)
[/php]

lizhongf

谢谢xyp1964斑竹及ohmylove 朋友热心指导，问题已解决