明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2670|回复: 7

[已解答] 初学LSP编写的填充源码,其中有个困扰很久的问题,求指教

[复制链接]
发表于 2013-7-27 11:18:59 | 显示全部楼层 |阅读模式
本帖最后由 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时,直接点击鼠标就能指定内部点,而不需要回车。


发表于 2013-7-27 12:58:19 | 显示全部楼层
(setq ans (getkword  ...
==>
(setq ans (getPoint ...

Cond 下 相应调整代码 ...
发表于 2013-7-27 15:17:54 | 显示全部楼层
楼主是意思   是不是关键词的响应 -----不按空格 即刻响应?

那么建议你用  grread 函数。
 楼主| 发表于 2013-7-27 20:36:38 | 显示全部楼层
本帖最后由 ztosen 于 2013-7-27 22:32 编辑
Andyhon 发表于 2013-7-27 12:58
(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)
)
发表于 2015-2-3 11:56:22 | 显示全部楼层
........................
发表于 2016-1-11 10:56:34 | 显示全部楼层
学习学习!
发表于 2016-1-11 16:43:39 | 显示全部楼层
压缩一下
  1. (defun C:H1 (/ ans e si ss)
  2.   (setvar "CMDECHO" 0)
  3.   (setq OLDERR *ERROR*
  4.             *ERROR* AEOERR
  5.   )
  6.   (command "undo" "group")
  7.   (prompt "\n当前样式:实体(SOLID)\n")
  8.   (initget "S F")
  9.   (setq ans (getpoint "\n拾取填充内部点或[修改图案填充对象(F)/选择填充边界(S)]:"))
  10.   (cond
  11.     ((= ans "F")
  12.       (if (and
  13.             (princ "\n选择图案填充对象:")
  14.             (setq ss (ssget '((0 . "HATCH"))))
  15.           )
  16.         (repeat (setq si (sslength ss))
  17.           (setq e (ssname ss (setq si (1- si))))
  18.           (command ".-hatchedit" e "p" "solid")
  19.         )
  20.       )
  21.     )
  22.     ((= ans "S")
  23.       (prompt "\n选择填充边界:")
  24.       (setq ss (ssget '((0 . "ARC,CIRCLE,*LINE"))))
  25.       (command "hatch" "p" "solid" "s" ss "" "")
  26.     )
  27.     (t
  28.       (if ans (progn
  29.         (command "hatch" ans "p" "solid")
  30.         (while (> (getvar "CMDACTIVE") 0) (command PAUSE))
  31.       ))
  32.     )
  33.   )
  34.   (setq *ERROR* OLDERR)
  35.   (command "_.undo" "end")
  36.   (setvar "CMDECHO" 1)
  37.   (princ)
  38. )
发表于 2016-1-16 18:02:35 | 显示全部楼层
求一个连续填充的lsp,就是批量输入坐标,程序按顺序一个个填充,如果有错误就跳过
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-5-20 19:39 , Processed in 0.181873 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表