求助:LISP写完了，DCL与LISP交互目前没有搞定

zhangcan0515

求助ISP写完了，DCL与LISP交互目前没有搞定。

hhh454

这里有几个可以学习的

song宋_74729

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   (setq dcl_file (open (setq tmp-dcl-file-name (vl-filename-mktemp nil nil  ".DCL")) "w"))
              (progn
                 (foreach x
                   '(  

                     "yu:dialog {"  
                     "    label = \"圆变多边形\" ;    "  
                     "    :boxed_column {"  
                     "        label = \"选择内外\" ;"  
                     "        :edit_box{label = \"边数：\" ;key = \"Text1\";  height=1.2;}"  
                     "        :button {label = \"内接于圆:<I>\"; key=\"bb1\"; height=3; }"  
                     "        :button {label = \"外切于圆:<C>\"; key=\"bb2\"; height=3; }"  
                     "        }"  
                     "    cancel_button;"  
                     "}"  
     ) (write-line x dcl_file) )
     (setq dcl_file (close dcl_file)))

(defun C:TT()
     (setq dcl_id (load_dialog tmp-dcl-file-name));加载DCL
         (if (not (new_dialog "yu" dcl_id))(exit)) ;;激活对话框
     (if (not side) (setq side 5))
     (set_tile "Text1" (rtos side 2 0))
     (action_tile "accept" "(get_yu_Text) (done_dialog 0)")
     (action_tile "bb1"    "(get_yu_Text) (done_dialog 1)")
     (action_tile "bb2"    "(get_yu_Text) (done_dialog 2)")
     (setq yua_d (start_dialog))
         (cond
             ((= yua_d 1) (setq ttype "I") (c:yuantd))
             ((= yua_d 2) (setq ttype "C") (c:yuantd))
         )      
)

(defun get_yu_Text()
     (setq side (atoi (get_tile "Text1")))
)

(defun c:yuantd()
  (setvar "cmdecho" 0)
  (setq osm (getvar "osmode"))
  (setvar "osmode" 0)
  (setq ss (ssget (list (cons 0 "CIRCLE")  )))
  (setq n 0)
  (repeat (sslength ss)
    (setq ent (ssname ss n)) ;;;获取提n个像素名
    (setq ent_data (entget ent))
    (setq r (cdr (assoc 40 ent_data))
             pc (cdr (assoc 10 ent_data))
        )
             (command "polygon" side pc ttype r)
    (setq n (1+ n))
  )
  (setvar "osmode" osm)
  (princ)
)

合并版 试用看看

muwind

我也不太会DCL 。试着弄了下 应该可以用了

2. (defun c:tt()
   
3.   (setvar "cmdecho" 0)
   
4.   (setq osm (getvar "osmode"))
   
5.   (setvar "osmode" 0)
   
6.   (princ "\n选择要做外切或内接正多边形的圆:")
   
7.   (setq p1 (getpoint))
   
8.   (setq p2 (getcorner p1))
   
9.   (if (> (car p1) (car p2))
   
10.     (setq ss (ssget "c" p1 p2))
    
11.     (setq ss (ssget "w" p1 p2))
    
12.   )
    
13.   (setq side (getint "\n正多边形的变数<5>:"))
    
14.   (if (= side nil)
    
15.     (setq side 5)
    
16.   )
    
17.   (SETQ DCL_ID(LOAD_DIALOG "圆变多边形.DCL"))
    
18.   (NEW_DIALOG "yu" DCL_ID)
    
19.   (ACTION_TILE "bb1" "(setq ttype 0)(done_dialog)(UNLOAD_DIALOG DCL_ID)")
    
20.   (ACTION_TILE "bb2" "(setq ttype 1)(done_dialog)(UNLOAD_DIALOG DCL_ID)")
    
21.   (START_DIALOG)
    
22.   (COND
    
23.     ((= ttype 0) (setq ttype "I"))
    
24.         ((= ttype 1) (setq ttype "C"))
    
25.         (T (setq ttype "I"))
    
26.   )
    
27.   (setq n 0)
    
28.   (repeat (sslength ss)
    
29.     (setq ent (ssname ss n))
    
30.     (setq ent_data (entget ent))
    
31.     (setq ent_type (cdr (assoc 0 ent_data)))
    
32.     (if        (= ent_type "CIRCLE")
    
33.       (progn (setq r (cdr (assoc 40 ent_data)))
    
34.              (setq pc (cdr (assoc 10 ent_data)))
    
35.              (command "polygon" side pc ttype r)
    
36.       )
    
37.     )
    
38.     (setq n (1+ n))
    
39.   )
    
40.   (setvar "osmode" osm)
    
41.   (princ)
    
42. )
    

(defun c:tt()<br />   (setvar "cmdecho" 0)<br />   (setq osm (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (princ "\n选择要做外切或内接正多边形的圆:")<br />   (setq p1 (getpoint))<br />   (setq p2 (getcorner p1))<br />   (if (> (car p1) (car p2))<br />     (setq ss (ssget "c" p1 p2))<br />     (setq ss (ssget "w" p1 p2))<br />   )<br />   (setq side (getint "\n正多边形的变数<5>:"))<br />   (if (= side nil)<br />     (setq side 5)<br />   )<br />   (SETQ DCL_ID(LOAD_DIALOG "圆变多边形.DCL"))<br />   (NEW_DIALOG "yu" DCL_ID)<br />   (ACTION_TILE "bb1" "(setq ttype 0)(done_dialog)(UNLOAD_DIALOG DCL_ID)") <br />   (ACTION_TILE "bb2" "(setq ttype 1)(done_dialog)(UNLOAD_DIALOG DCL_ID)") <br />   (START_DIALOG)<br />   (COND <br />     ((= ttype 0) (setq ttype "I"))<br />         ((= ttype 1) (setq ttype "C"))<br />         (T (setq ttype "I"))<br />   )<br />   (setq n 0)<br />   (repeat (sslength ss)<br />     (setq ent (ssname ss n))<br />     (setq ent_data (entget ent))<br />     (setq ent_type (cdr (assoc 0 ent_data)))<br />     (if        (= ent_type "CIRCLE")<br />       (progn (setq r (cdr (assoc 40 ent_data)))<br />              (setq pc (cdr (assoc 10 ent_data)))<br />              (command "polygon" side pc ttype r)<br />       )<br />     )<br />     (setq n (1+ n))<br />   )<br />   (setvar "osmode" osm)<br />   (princ)<br /> )<br />

sniper1111

目前是按照你程序操作顺序来的。
也可以有有另外一操作方式，就是执行命令后按空格或者回车设置参数，如没有按空格或者回车，则选圆按照上次设定好的 参数生成多边形，这样的使用参数不变的情况下批量操作剩下了每次选择形式的操作。

时间有限，比较潦草。

zhangcan0515

之前是我考虑不周到，经过院长和ZZ老师普及知识。对DCL交互有了新的认识。

zhangcan0515

muwind 发表于 2022-5-8 13:07
我也不太会DCL 。试着弄了下 应该可以用了

谢谢老师帮助与指导，我也在学习DCL交互！！

hhh454

猫老师的VB转DCL，挺好的，关联都已经做好了，你可以看看相关的帖子

zhangcan0515

hhh454 发表于 2022-5-8 17:37
猫老师的VB转DCL，挺好的，关联都已经做好了，你可以看看相关的帖子

猫老师的这个用过了，我想着先不用别人的插件搞这种的。本方法做。DCL官方自带的玩熟悉了，在利用插件。

hhh454

zhangcan0515 发表于 2022-5-8 20:40
猫老师的这个用过了，我想着先不用别人的插件搞这种的。本方法做。DCL官方自带的玩熟悉了，在利用插件。

建议直接用就行，老师都研究好了，腾出时间写主程序部分，岂不更好

zhangcan0515

hhh454 发表于 2022-5-9 01:30
这里有几个可以学习的

老师你说的有一定道理，我还是想把自带的搞懂在研究其他的人的。