ztosen 发表于 2013-7-27 11:18:59

初学LSP编写的填充源码，其中有个困扰很久的问题，求指教

本帖最后由 ztosen 于 2013-7-27 22:31 编辑

(Defun C:H2 (/ e e1 la ps si smx ss ssh)
(SETVAR "CMDECHO" 0)
(SETQ OLDERR *ERROR*
            *ERROR* AEOERR
)
(COMMAND "undo" "group")
(prompt "\n当前样式:砌墙(ANSI31) 比例:200\n")
(initget "S F")
(setq ans (getkword "\n修改图案填充对象(S)/选择填充边界(F)/拾取填充内部点(直接回车)："))
(cond
    ((= ans "S")
      (if (and
            (princ "\n选择图案填充对象：")
            (setq ss (ssget (list '(0 . "hatch"))))
          )
      (progn
          (setq smx (sslength ss)
                si 0
          )
          (while (< si smx)
            (setq e (ssname ss si)
                  si (1+ si)
            )
            (if t
            (progn
                (if nil                     
                  (command ".-hatchedit" e e1 "p" "ANSI31" "100" "0")
                  (command ".-hatchedit" e "p" "ANSI31" "100" "0")
                )                     
            )
            )
          )
      )
      )
    )
    ((= ans "F")
      (prompt "\n选择填充边界：")
      (setq ss (ssget))
      (command "bhatch" "p" "ANSI31" "200" "0" "s" ss "" "")
    )
    (t
      (prompt "\n拾取填充内部点：")
      (command "bhatch" "p" "ANSI31" "200" "0")
      (while (> (getvar "CMDACTIVE") 0)
      (command PAUSE)
      )
    )
)
(SETQ *ERROR* OLDERR)
(COMMAND "_.undo" "end")
(PRINC)
)

大师们好，我想输入命令后，提示输入getkword时，直接点击鼠标就能指定内部点，而不需要回车。


Andyhon 发表于 2013-7-27 12:58:19

(setq ans (getkword...
==>
(setq ans (getPoint ...

Cond 下 相应调整代码 ...

wowan1314 发表于 2013-7-27 15:17:54

楼主是意思   是不是关键词的响应 -----不按空格 即刻响应？

那么建议你用grread 函数。

ztosen 发表于 2013-7-27 20:36:38

本帖最后由 ztosen 于 2013-7-27 22:32 编辑

Andyhon 发表于 2013-7-27 12:58 static/image/common/back.gif
(setq ans (getkword...
==>
(setq ans (getPoint ...

谢谢老大指教，原来这么简单。
为什么自己就没想到用getPoint~

(Defun C:H1 (/ e e1 la ps si smx ss ssh)
(SETVAR "CMDECHO" 0)
(SETQ OLDERR *ERROR*
            *ERROR* AEOERR
)
(COMMAND "undo" "group")
(prompt "\n当前样式:实体(SOLID)\n")
(initget "S F")
(setq ans (getPoint "\n拾取填充内部点或[修改图案填充对象(F)/选择填充边界(S)]："))
(cond
    ((= ans "F")
      (if (and
            (princ "\n选择图案填充对象：")
            (setq ss (ssget (list '(0 . "hatch"))))
          )
      (progn
          (setq smx (sslength ss)
                si 0
          )
          (while (< si smx)
            (setq e (ssname ss si)
                  si (1+ si)
            )
            (if t
            (progn
                (if nil
                  (command ".-hatchedit" e e1 "p" "solid")
                  (command ".-hatchedit" e "p" "solid")
                )
            )
            )
          )
      )
      )
    )
    ((= ans "S")
      (prompt "\n选择填充边界：")
      (setq ss (ssget))
      (command "bhatch" "p" "solid" "s" ss "" "")
    )
    (t
      (if (/= ans nil)
      (PROGN
          (command "bhatch" ans "p" "solid")
          (while (> (getvar "CMDACTIVE") 0)
            (command PAUSE)
          )
          (PRINC)
      )
      )
    )
)
(SETQ *ERROR* OLDERR)
(COMMAND "_.undo" "end")
(PRINC)
)

chbddzx12 发表于 2015-2-3 11:56:22

........................

迷不知途 发表于 2016-1-11 10:56:34

学习学习！

ZZXXQQ 发表于 2016-1-11 16:43:39

压缩一下(defun C:H1 (/ ans e si ss)
(setvar "CMDECHO" 0)
(setq OLDERR *ERROR*
            *ERROR* AEOERR
)
(command "undo" "group")
(prompt "\n当前样式:实体(SOLID)\n")
(initget "S F")
(setq ans (getpoint "\n拾取填充内部点或[修改图案填充对象(F)/选择填充边界(S)]："))
(cond
    ((= ans "F")
      (if (and
            (princ "\n选择图案填充对象：")
            (setq ss (ssget '((0 . "HATCH"))))
          )
      (repeat (setq si (sslength ss))
          (setq e (ssname ss (setq si (1- si))))
          (command ".-hatchedit" e "p" "solid")
      )
      )
    )
    ((= ans "S")
      (prompt "\n选择填充边界：")
      (setq ss (ssget '((0 . "ARC,CIRCLE,*LINE"))))
      (command "hatch" "p" "solid" "s" ss "" "")
    )
    (t
      (if ans (progn
      (command "hatch" ans "p" "solid")
      (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
      ))
    )
)
(setq *ERROR* OLDERR)
(command "_.undo" "end")
(setvar "CMDECHO" 1)
(princ)
)

wu112031853 发表于 2016-1-16 18:02:35

求一个连续填充的lsp，就是批量输入坐标，程序按顺序一个个填充，如果有错误就跳过
页: [1]
查看完整版本: 初学LSP编写的填充源码，其中有个困扰很久的问题，求指教