[LISP程序]：救命呀！老婆要求一周内解决，否则杀了我！！！

bdgxhmldzj

用LISP程序绘制图形，并指定一个插入点，当在Auto CAD窗口中执行包含此段程序的函数时，在需要指定插入点时，要能象插入块一样同时动态地显示所绘图形，直至指定了插入点。简单地说，就是能够象插入块一样地显示图形。如何编这个LISP程序？
各位大侠，救命呀！！！

aeo

除非用arx

用grread也可以,但不好

建议直接用command +pause吧

Dallas_whu

用"ACET-SS-DRAG-MOVE "函数,需要装"express tools",给你个简单的例子,可以参考一下.
[PHP]

;;;绘制竖直构造线
(DEFUN C:H (/ LOOP_ID PT SS)
  (SETQ LOOP_ID T)
  (IF (= (TBLOBJNAME "LAYER" "辅助线") NIL)
    (PROGN
      (ENTMAKE (LIST
                 '(0 . "LAYER")
                 '(100 . "AcDbSymbolTableRecord")
                 '(100 . "AcDbLayerTableRecord")
                 '(6 . "CONTINUOUS")        ;线型
                 '(62 . 2)                ;颜色
                 '(70 . 0)                ;图层状态
                 (CONS 2 "辅助线")        ;图层名
               )
      )
    )
  )
  (SETVAR "CLAYER" "辅助线")
  (PRINC "\n***  竖直构造线，长度为300 ***")
  (WHILE LOOP_ID
    (COMMAND "_.LINE" '(-20000 0 0) '(-20300 0 0) "")
    (SETQ SS (SSADD))
    (SETQ SS (SSADD (ENTLAST) SS))
    (SETVAR "CURSORSIZE" 1)
    (SETVAR "OSMODE" (+ 1 2 4 8 32 512))
    (SETQ PT (ACET-SS-DRAG-MOVE SS '(-20150 0 0) "插入点:"))
    (SETVAR "OSMODE" 0)
     (IF PT
       (COMMAND "_.MOVE" SS "" '(-20150 0 0) PT)
       (PROGN
         (COMMAND "_.ERASE" SS "")
         (SETQ LOOP_ID NIL)
         )
     )
    (SETVAR "CURSORSIZE" 5)
  )
  (PRINC)
)
[/PHP]

cy956

3楼做得烦琐了。可用entmake直接做线，直接定义图层颜色，如果本图内无此层则自动建层。

雨箭风刀

要是你老婆看了这个帖子，会不会甩了你，而投奔Dallas_whu 呢？

还可以这样，生成实体后，放入选集，调用command  move
就得到你要的效果

雪山飞狐(lzh)

找一个懂Arx的帮你做一个:)
前几天倒是做了一个,不过是用.net做的,只有2007可以用:)

leochen

我编的动态插入文字，你参考下
(defun d-text (txt / tmp a)
  (setq tmp t)
  (entmake txt)
  (princ "\n选择点：")
  (while tmp
    (setq a (grread t 4 0))
    (cond
      ((= (car a) 3)
       (entdel (entlast))
       (setq txt (subst (cons 10 (cadr a)) (assoc 10 txt) txt)
             tmp nil
       )
       (entmake txt)
       (redraw)
      )
      ((= (car a) 5)
       (entdel (entlast))
       (setq txt (subst (cons 10 (cadr a)) (assoc 10 txt) txt))
       (entmake txt)
       (redraw (entlast) 3)
      )
      ((or (= (car a) 12) (= (car a) 25))
       (entdel (entlast))
       (setq txt (subst (cons 10 (cadr a)) (assoc 10 txt) txt))
       (entmake txt)
      )
    )
  )
  (princ)
)