[求助]：想求一个自动封口的用PL画墙柱轮廓的LISP

yetaos

本人LISP刚进门，本想编一个沿建筑外形画墙柱外轮廓的LISP代码，只是有几个问题实在是水平有限解决不了，第一、如果在画完PL线后还原到原来的图层。第二，如何在围了一圈回到起始后用鼠标右键结束命令时让PL线自动闭合，而不是有个小缺口，谢谢大家

gjt1244

我也是个Lisp的新手，楼主的问题我也想知道答案，期待高手指点。。。

hi71400

(defun c:hh (/ lay colo lt old_lay obj w)
  (setq lay "你想画的图层")
  (setq colo 1)                                ;"你想设的图层颜色" 1--红
  (setq lt "你想用的线性")
  (setq w  10) ;"你想s设的线宽")
  (setq old_lay (getvar "clayer"))        ;保存当前层
                                  ;设置或新建你自己的图层  
  (if (/= (getvar "clayer") lay)
    (command "_.-layer"        "m" lay        "s" lay        "c" colo "" "l"        lt "" "")
  )
  (setq pt0 (getpoint "\n画闭合线\n第一点:"))
  (command "pline" pt0 "w" w w)
  (command pt0)
  (while pt0
    (setq pt0 (getpoint pt0 "\n下一点"))
    (command pt0)
  )

  (setq obj (entlast))                        ;保存你刚画的线
  (command "pedit" obj "c" "")                ;闭*合*它
  (setvar "clayer" old_lay)
  (princ)
)

yetaos

小遗憾，还是不能封口，在封口处有个小缺口，不过还是非常感谢

hi71400

这个是cad和自身lisp兼容性的问题,错在组码90上
由pline用命令画的其90组码为4
由lisp调用pline画的其90组码为5
而且不能修改! --至少我没有办法.
请另外的好心人帮你吧.
本来多画第一点第到第二点,可以达到无缺口的效果
---可,太哪个龌龊.

它山之石

直接利用PLINE命令的闭合选项就可以达到无缺口的效果，更新后的程序如下：

[php]
(defun c:hh (/ lay colo lt old_lay obj w)
;;;  (setq lay "0")
;;;  (setq colo 1)                                ;"你想设的图层颜色" 1--红
;;;  (setq lt "你想用的线性")
  (setq w 50)                                ;"你想s设的线宽")
  (setq old_lay (getvar "clayer"))        ;保存当前层
;;;设置或新建你自己的图层
;;;  (if (/= (getvar "clayer") lay)
;;;    (command "_.-layer"        "m" lay        "s" lay        "c" colo "" "l"        lt "" "") ;_ 结束command
;;;  ) ;_ 结束if
  (setq pt0 (getpoint "\n画闭合线\n第一点:"))
  (command "pline" pt0 "w" w w)
  ;;;(command pt0)
  (while pt0
    (setq pt0 (getpoint pt0 "\n下一点"))
    (if        pt0
      (command pt0)
      (command "c")
    ) ;_ 结束if
  ) ;_ 结束while
;;; (setq obj (entlast))                        ;保存你刚画的线
;;; (command "pedit" obj "c" "")                ;闭*合*它
  (setvar "clayer" old_lay)
  (princ)
) ;_ 结束defun
[/php]

hi71400

啊 !!
学艺不精,差点点误人啊
最初我写的是
(while pt0
    (setq pt0 (getpoint pt0 "\n下一点"))
    (if    pt0
      (command pt0)
    ) ;_ 结束if
  ) ;_ 结束while
(command  c )    ---掉了引号,没有报错,也不能不能画上最后一段
所以才用了pedit
1楼提出有缺口后,我老在检查为什么没封好,发现了pline自身能封,用命令状态画的能封
然后查了系统变量,试了不少也没找到
最后查组码,发现了区别.
试图改组码,失败,,,,,
最后,放弃,,,,,,,,,,,,,,,,,
看来,还得多学习啊!谢谢 蜘蛛 :)

yetaos

完美的答案，多谢两位大虾的指教！
这是我完成后的结果，按照墙的外轮廓画封闭的外框，然后自动填充后置
(defun c:qi()
             (setq odlay (getvar "clayer"))
             (setvar "osmode" 32)
             (if (not (tblsearch "layer" "wall"))           
             (command "-layer" "new" "wall" "c" "2" "wall" ""))
             (command "-layer" "s" "wall" "")
             (setq w 25)
             (setq pt0 (getpoint "\n画闭合线\n第一点:"))
             (command "pline" pt0 "w" w w)
             (while pt0
             (setq pt0 (getpoint pt0 "\n下一点"))
             (if    pt0
             (command pt0)
             (command "c")
             )
             )
            (if (not (tblsearch "layer" "hatch"))
             (command "-layer" "new" "hatch" "color" "22" "hatch" ""))
             (command "-layer"  "s" "hatch" "")
             (setq a (entlast))
             (setq b (ssadd))
            (command "-Bhatch" "P" "solid" "S" a "" "A" "A" "Y" "" "")
             (while (entnext a)
             (setq a (entnext a))
             (setq b (ssadd a b))
              )
           (command "draworder" b "" "b" )  
            (command "-layer" "s" odlay "")
             )

狂刀

2. 
   
3. ;can "undo"
   
4. (defun c:tt ()
   
5.   (setq w 50)
   
6.   (vl-cmdf ".pline" (getpoint "\nfirst point:") "w" w "")
   
7.   (while (/= 0 (getvar "cmdactive")) (vl-cmdf pause))
   
8.   (vl-cmdf "pedit" "l" "cl" "")
   
9. )

<br /> ;can "undo"<br /> (defun c:tt ()<br />   (setq w 50)<br />   (vl-cmdf ".pline" (getpoint "\nfirst point:") "w" w "")<br />   (while (/= 0 (getvar "cmdactive")) (vl-cmdf pause))<br />   (vl-cmdf "pedit" "l" "cl" "")<br /> )