[求助]：autolisp 程序 不能运行

lc_shi

以下是在一文本周围加一边框，是从一教学网站上下载的，但不能运行，请指教！



(DEFUN C:TEXT_F ( ) (SETQ OBJ (ENTSEL "\nSelect Text : "))
(IF (= OBJ NIL) (PRINC "\nNone Object Select") (PROGN
(SETQ ENT (ENTGET (CAR OBJ)))
(IF (/= CDR (ASSOC 0 ENT)) "TEXT")
(PRINC "\nObject Type Error") (PROGN
(SETQ TEMP (CADR (TEXTBOX (LIST (ASSOC 1 ENT))))
TEMP_W (CAR TEMP) TEMP_H (CADR TEMP)
PT_BASE (CDR (ASSOC 10 ENT)))
(COMMAND "PLINE" PT_BASE
(SETQ PT_TEMP (POLAR PT_BASE 0 TEMP_W))
(SETQ PT_TEMP (POLAR PT_TEMP (/ PI 2) TEMP_H))
(SETQ PT_TEMP (POLAR PT_TEMP PI TEMP_W)) "C")
) )
) )
(PRINC))

xyp1964

[php]
(DEFUN C:TEXT_F        ()
  (SETQ OBJ (ENTSEL "\nSelect Text : "))
  (IF (= OBJ NIL)
    (PRINC "\nNone Object Select")
    (PROGN
      (SETQ ENT (ENTGET (CAR OBJ)))
      (IF (/= CDR (ASSOC 0 ENT))
        "TEXT"
      )
      (PRINC "\nObject Type Error")
      (PROGN
        (SETQ TEMP    (CADR (TEXTBOX (LIST (ASSOC 1 ENT))))
              TEMP_W  (CAR TEMP)
              TEMP_H  (CADR TEMP)
              PT_BASE (CDR (ASSOC 10 ENT))
        )
        (COMMAND "PLINE"
                 PT_BASE
                 (SETQ PT_TEMP (POLAR PT_BASE 0 TEMP_W))
                 (SETQ PT_TEMP (POLAR PT_TEMP (/ PI 2) TEMP_H))
                 (SETQ PT_TEMP (POLAR PT_TEMP PI TEMP_W))
                 "C"
        )
      )
    )
  )
)
(PRINC)
[/php]

aeo

哪个教学网站骗人呀!

cad的帮助里有实例,Visual LISP Tutorial 里面.

或者其他地方，你找找，肯定有.

lc_shi

谢谢！

zxq0220

程序有误，不支持字宽比例和文字倾角。
程序更改后如下：
[php]
(DEFUN C:TEXT_F ()
(SETQ OBJ (ENTSEL "\nSelect Text : "))
(IF (/= OBJ nil) (PROGN
  (SETQ ENT (ENTGET (CAR OBJ)))
  (IF (= (CDR (ASSOC 0 ENT)) "TEXT") (PROGN
   (SETQ TEMP    (CADR (TEXTBOX (LIST (ASSOC 1 ENT))))
         PT_BASE (CDR (ASSOC 10 ENT))
         ANG     (CDR (ASSOC 50 ENT))
         TEXTW   (CDR (ASSOC 41 ENT))
         TEMP_W  (* (CAR TEMP) TEXTW)
         TEMP_H  (CADR TEMP))
   (COMMAND "PLINE" PT_BASE
         (SETQ PT_TEMP (POLAR PT_BASE ANG TEMP_W))
         (POLAR PT_TEMP (+ (/ PI 2) ANG) TEMP_H)
         (POLAR PT_BASE (+ (/ PI 2) ANG) TEMP_H)
         "C"
   )
  ))
))
(PRINC)
)
[/php]

lsjjm

同样功能且可批处理：
[PHP]
(defun c:test ()
  (setq ss (ssget '((0 . "*TEXT"))) n 0)
  (while (< n (sslength ss))
    (setq b (acet-geom-extents (ssname ss n)))
    (vl-cmdf "rectang" (car b)(cadr b))
    (setq n (1+ n))
  )
)
[/PHP]

supor

能不能解释一下

aeo

最初由 lsjjm 发布
[B]同样功能且可批处理：
[PHP]
(defun c:test ()
  (setq ss (ssget '((0 . "*TEXT"))) n 0)
  (while (< n (sslength ss))
    (setq b (acet-geom-extents (ssname ss n)))
    (vl-cmdf "rectang" (car b)(ca... [/B]

有角度怎么办?


==================
能不能解释一下

相当于把文字移动到原点，再转成0度，这时的textbox就可以画框了，完了，一起还原到原来的状态.