DCL和Lisp的帮助乐筑天下 - Powered by Discuz! Archiver

prodromosm 发表于 2022-7-5 16:21:41

DCL和Lisp的帮助

你好我正在试着用lisp通过dcl和幻灯片进行操作

我有一个包含4个不同lisp代码的lisp文件，还有一个包含4张幻灯片的dcl文件。我想在单击幻灯片时运行例程。查看附件*。zip文件

谢谢
十字路口。rar公司

Grrr 发表于 2022-7-5 16:26:41

您的dcl代码中有一些问题，第二行缺少双引号，
定义对话框后，包含了几个带有ok\u cancel和errtile的间隔符。

我认为应该这样格式化：

intersections : dialog
{ label = "ΚΑΤΑΣΚΕΥΕΣΣΗΜΕΙΩΝ Topocad 2017";

spacer_1;
: text_part { label = "Επιλέξτε είδος Κατασκευής Σημείου :" ; alignment = left; }
spacer_1;

: row
{ children_height = 8.0; children_width = 29.0; children_fixed_width = true; children_fixed_height = true;
: image_button{ key = "me" ; color = graphics_background; }
: image_button { key = "te" ; color = graphics_background; }
}
: row
{ children_height = 8.0; children_width = 29.0; children_fixed_width = true; children_fixed_height = true;
: image_button{ key = "pse" ; color = graphics_background; }
: image_button { key = "tk" ; color = graphics_background; }
}
spacer_1; ok_cancel; : errtile { width = 34; }
}

prodromosm 发表于 2022-7-5 16:35:19

您好，Grrr。谢谢你的回复。我做了更改，但仍然没有加载dcl文件

prodromosm 发表于 2022-7-5 16:36:20

有什么想法吗？

BIGAL 发表于 2022-7-5 16:43:49

我快速看了一下，你似乎没有开始图像处理，也没有暗示哪个图像放在哪个方块里。我将尝试查找一些示例代码。

(start_image "icon_noi")
(slide_image 0 0 (- (dimx_tile "icon_noi") 1) (- (dimy_tile "icon_noi") 1) "BIG-ALblank")
(end_image)

prodromosm 发表于 2022-7-5 16:48:42

嗨，比格尔。你能给我举个例子吗，因为我不懂。。。。。

谢谢

Grrr 发表于 2022-7-5 16:53:25

我错认为children_height=8.0；children_width=29.0；属性，但以下是一个示例：

; Slides Example
(defun C:test ( / L *error* dcl des dch dcf slidefiles r )

(setq L
'(
("te" ; inter
   (
      (lambda ( / o1 o2 )
      (and (setq o1 (car (entsel "\nFirst Object: "))) (setq o2 (car (entsel "\nSecond Object: ")))
         (foreach p (LM:Intersections (vlax-ename->vla-object o1) (vlax-ename->vla-object o2) acextendboth)
            (entmake (list '(0 . "POINT") (cons 10 p)))
         )
      )
      )
   )
)
("tk" ; interset
   (
      (lambda ( SS ) (if SS (foreach p (LM:intersectionsinset SS) (entmake (list '(0 . "POINT") (cons 10 p))) ) ) )
      (progn (princ "\nSelect objects to intersect: ") (ssget) )
   )
)
("pse" ; perpt
   (
      (lambda ( / dis enx pt1 pt2 pt3 sel tmp )
      (while
         (not
            (progn (setvar 'errno 0) (setq sel (entsel "\nSelect line or polyline segment: "))
            (cond ( (= 7 (getvar 'errno)) (prompt "\nMissed, try again.") ) ( (null sel) )
               ( (= "LINE" (cdr (assoc 0 (setq enx (entget (car sel))))))
                  (setq
                  pt1 (trans (cdr (assoc 10 enx)) 0 1)
                  pt2 (trans (cdr (assoc 11 enx)) 0 1)
                  dis (distance pt1 pt2)
                  )
               )
               ( (= "LWPOLYLINE" (cdr (assoc 0 enx)))
                  (setq
                  tmp (vlax-curve-getclosestpointto (car sel) (trans (cadr sel) 1 0))
                  tmp (fix (+ 1e-8 (vlax-curve-getparamatpoint (car sel) tmp)))
                  pt1 (trans (vlax-curve-getpointatparam (car sel) tmp)0 1)
                  pt2 (trans (vlax-curve-getpointatparam (car sel) (1+ tmp)) 0 1)
                  dis (distance pt1 pt2)
                  )
               )
               ( (prompt "\nThe selected object is not a line or 2D polyline.") )
            )
            )
         )
      )
      (if (and pt1 pt2 (setq pt3 (getpoint "\nSpecify 3rd point: ")))
         (entmake
            (list '(000 . "POINT") '(008 . "section")
            (cons 010 (trans (polar pt1 (angle pt1 pt2) (apply '+ (mapcar '* (mapcar '- pt3 pt1) (mapcar '(lambda ( a b ) (/ (- a b) dis)) pt2 pt1) ) ) ) 1 0) )
            (cons 210 (trans '(0 0 1) 1 0 t))
            )
         )
      )
      (princ)
      )
   )
)
("me" ; MidPl
   (
      (lambda ( / e enx o prm mp )
      (and
         (setq e (car (entsel "\nSelect line: "))) (setq enx (entget e))
         (member (cdr (assoc 0 enx)) '("POLYLINE" "LWPOLYLINE" "LINE"))
         (setq o (vlax-ename->vla-object e)) (setq prm (vlax-curve-getEndParam o))
         (setq mp (vlax-curve-getPointAtDist o (* 0.5 (vlax-curve-getDistAtParam o prm))))
         (entmake (list '(0 . "POINT") (cons 10 mp)))
         (princ (strcat "\nPoint object created at mid-point: " (vl-prin1-to-string mp))) (princ)
      )
      )
   )
)
); list
); setq L

(defun *error* ( msg )
(and (< 0 dch) (unload_dialog dch))
(and (eq 'FILE (type des)) (close des))
(and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
(and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
(princ)
); defun *error*

(cond
(
(progn
   (setq slidefiles (mapcar '(lambda (x) (strcat x ".sld")) '("me" "te" "pse" "tk"))) ; <- adjust slidernames
   (vl-some '(lambda (x) (if (not (findfile x)) (princ (strcat "\nUnable to find \"" x "\" file.")))) slidefiles)
)
)
(
(not
   (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
      (princ
      (apply 'strcat
         (mapcar (function (lambda (x) (apply 'strcat (mapcar 'chr x))))
            '(
            (116 101 115 116 32 58 32 100 105 97 108 111 103 32) (123 32 108 97 98 101 108 32 61 32 34 73 110 116 101 114 115 101 99 116 105 111 110 115 34 59)
            (32 32 58 32 98 111 120 101 100 95 99 111 108 117 109 110 32)
            (32 32 123 32 108 97 98 101 108 32 61 32 34 67 104 111 111 115 101 32 97 99 116 105 111 110 34 59 32 115 112 97 99 101 114 95 49 59)
            (32 32 32 32 58 32 114 111 119 32)
            (32 32 32 32 123 32 99 104 105 108 100 114 101 110 95 102 105 120 101 100 95 119 105 100 116 104 32 61 32 116 114 117
               101 59 32 99 104 105 108 100 114 101 110 95 102 105 120 101 100 95 104 101 105 103 104 116 32 61 32 116 114 117 101 59
            )
            (32 32 32 32 32 32 58 32 105 109 97 103 101 95 98 117 116 116 111 110 32 32 123 32 107 101 121 32 61 32 34 109 101 34 59 32 104 101 105 103
               104 116 32 61    32 49 50 59 32 119 105100116 104 32 61 32    51 50 59 32 99 111 108111114
               32 61 32 10311497 112 10410599 11595    98 97 99 107103114111117 11010059 32 125
            )
            (32 32 32 32 32 32 58 32 10510997 10310195 98 117 116 11611111032 12332 107 10112132
               61 32 34 116 10134 59 32 104101 105103104 116 32 61 32    49 50 59 32 119105 100116104
               32 61 32 51 50 59 32 99 111108 11111432 61 32 103 11497 112104 10599 115 95 98    97
               99 107 103114111117110 10059 32 125
            )
            (32 32 32 32 125) (32 32 32 32 58 32 114 111 119 32)
            (32 32 32 32 12332 99 104 105108100 114101110 95 102 10512010110095 119105100 11610432
               61 32 11611411710159 32 99 104 105108100 114101 11095    102105120 10110095 104101105
               103104 11632    61 32 116 114117101 59
            )
            (32 32 32 32 32    32 58 32 10510997 10310195 98 117 11611611111032 32 12332 107101121
               32 61 32 34    112115101 34 59 32 104101105 103104 11632    61 32 49 50 59 32 119105100
               116104 32 61    32 51 50 59 32 99 111108111 11432 61 32    10311497 112104105 99 11595
               98 97 99 107103114111 117110100 59 32    125
            )
            (32 32 32 32 32    32 58 32 10510997 10310195 98 117 11611611111032 12332 107 10112132
               61 32 34 11610734 59 32 104101 105103104 11632 61 32    49 50 59 32 119105 100116104
               32 61 32 51    50 59 32 99 111108 11111432 61 32 10311497 112104 10599 115 95 98    97
               99 107 103114111117110 10059 32 125
            )
            (32 32 32 32 125) (32 32 125)
            (32 32 115 112 97 99 101 114 95 49 59 32 111 107 95 111 110 108 121 59 32 58 32 116 101 120
               116 32 123 32 108 97 98 101 108 32 61 32 34 67 114 101 100 105 116 115 32 116 111 58 32 76
               101 101 32 77 97 99 34 59 32 97 108 105 103 110 109 101 110 116 32 61 32 114 105 103 104 116 59 32 125
            )
            (125)
            )
         )
      )
      des
      )
      (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl)))
   ); and
); not
(princ "\nUnable to write or load the DCL file.")
)
( (not (new_dialog "test" dch)) (princ "\nUnable to display the dialog") )
(
(progn
   (mapcar (function (lambda (x) (action_tile x (vl-prin1-to-string '(progn (done_dialog 1) (setq r $key)))))) '("me" "te" "pse" "tk") )
   (mapcar
      (function
      (lambda ( key sld / w h ) ; (slide_image x1 y1 width height sldname)
         (setq w (1- (dimx_tile key))) (setq h (1- (dimy_tile key)))
         (start_image key) (fill_image 0 0 w h 0) (slide_image 0 0 w h sld) (end_image) ; (fill_image ...) might be redundant
         ; (start_image "me") (slide_image 0 0 (1- (dimx_tile "me")) (1- (dimy_tile "me")) "SlideName.sld") (end_image)
      )
      )
      '("me" "te" "pse" "tk") slidefiles
   )
   (action_tile "accept" (vl-prin1-to-string '(progn (princ "\nBye!") (done_dialog 2))))
   (/= 1 (setq dcf (start_dialog)))
); progn
(princ) ; (princ "\nUser cancelled the dialog.")
)
(T (eval (cadr (assoc r L))) )
); cond
(*error* nil) (princ)
); defun

;;--------------------=={ Intersections }==-------------------;;
;;                                                          ;;
;;Returns a list of all points of intersection between    ;;
;;two objects for the given intersection mode.          ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2012 - www.lee-mac.com    ;;
;;------------------------------------------------------------;;
;;Arguments:                                              ;;
;;obj1, obj2 - VLA-Objects                               ;;
;;mode    - acextendoption enum of intersectwith method;;
;;------------------------------------------------------------;;
;;Returns:List of intersection points, or nil          ;;
;;------------------------------------------------------------;;

(defun LM:Intersections ( obj1 obj2 mode / l r )
(setq l (vlax-invoke obj1 'intersectwith obj2 mode))
(repeat (/ (length l) 3)
(setq r (cons (list (car l) (cadr l) (caddr l)) r)
l (cdddr l)
)
)
(reverse r)
)

;; Intersections in Set-Lee Mac
;; Returns a list of all points of intersection between all objects in a supplied selection set.
;; sel - Selection Set

(defun LM:intersectionsinset ( sel / id1 id2 ob1 ob2 rtn )
(repeat (setq id1 (sslength sel))
(setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
(repeat (setq id2 id1)
(setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2))))
   rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
)
)
)
(apply 'append (reverse rtn))
)

prodromosm 发表于 2022-7-5 16:55:07

谢谢你的帮助。你能解释一下这些数字是多少吗？你用什么程序来做这个？

(mapcar (function (lambda (x) (apply 'strcat (mapcar 'chr x))))
            '(
            (116 101 115 116 32 58 32 100 105 97 108 111 103 32) (123 32 108 97 98 101 108 32 61 32 34 73 110 116 101 114 115 101 99 116 105 111 110 115 34 59)
            (32 32 58 32 98 111 120 101 100 95 99 111 108 117 109 110 32)
            (32 32 123 32 108 97 98 101 108 32 61 32 34 67 104 111 111 115 101 32 97 99 116 105 111 110 34 59 32 115 112 97 99 101 114 95 49 59)
            (32 32 32 32 58 32 114 111 119 32)
            (32 32 32 32 123 32 99 104 105 108 100 114 101 110 95 102 105 120 101 100 95 119 105 100 116 104 32 61 32 116 114 117
               101 59 32 99 104 105 108 100 114 101 110 95 102 105 120 101 100 95 104 101 105 103 104 116 32 61 32 116 114 117 101 59
            )
            (32 32 32 32 32 32 58 32 105 109 97 103 101 95 98 117 116 116 111 110 32 32 123 32 107 101 121 32 61 32 34 109 101 34 59 32 104 101 105 103
               104 116 32 61    32 49 50 59 32 119 105100116 104 32 61 32    51 50 59 32 99 111 108111114
               32 61 32 10311497 112 10410599 11595    98 97 99 107103114111117 11010059 32 125
            )
            (32 32 32 32 32 32 58 32 10510997 10310195 98 117 116 11611111032 12332 107 10112132
               61 32 34 116 10134 59 32 104101 105103104 116 32 61 32    49 50 59 32 119105 100116104
               32 61 32 51 50 59 32 99 111108 11111432 61 32 103 11497 112104 10599 115 95 98    97
               99 107 103114111117110 10059 32 125
            )
            (32 32 32 32 125) (32 32 32 32 58 32 114 111 119 32)
            (32 32 32 32 12332 99 104 105108100 114101110 95 102 10512010110095 119105100 11610432
               61 32 11611411710159 32 99 104 105108100 114101 11095    102105120 10110095 104101105
               103104 11632    61 32 116 114117101 59
            )
            (32 32 32 32 32    32 58 32 10510997 10310195 98 117 11611611111032 32 12332 107101121
               32 61 32 34    112115101 34 59 32 104101105 103104 11632    61 32 49 50 59 32 119105100
               116104 32 61    32 51 50 59 32 99 111108111 11432 61 32    10311497 112104105 99 11595
               98 97 99 107103114111 117110100 59 32    125
            )
            (32 32 32 32 32    32 58 32 10510997 10310195 98 117 11611611111032 12332 107 10112132
               61 32 34 11610734 59 32 104101 105103104 11632 61 32    49 50 59 32 119105 100116104
               32 61 32 51    50 59 32 99 111108 11111432 61 32 10311497 112104 10599 115 95 98    97
               99 107 103114111117110 10059 32 125
            )
            (32 32 32 32 125) (32 32 125)
            (32 32 115 112 97 99 101 114 95 49 59 32 111 107 95 111 110 108 121 59 32 58 32 116 101 120
               116 32 123 32 108 97 98 101 108 32 61 32 34 67 114 101 100 105 116 115 32 116 111 58 32 76
               101 101 32 77 97 99 34 59 32 97 108 105 103 110 109 101 110 116 32 61 32 114 105 103 104 116 59 32 125
            )
            (125)
            )

Grrr 发表于 2022-7-5 17:02:53

这只是DCL代码-硬编码一点-以防止轻易删除李的昵称。
由于他演示了所有或几乎所有提供的子功能和整个动态dcl技术，因此实际上约90%的代码中都有他的存在。
有一点欣赏是很好的（而不是把他的代码放在不同的帖子里，并声称拥有权威）。

prodromosm 发表于 2022-7-5 17:06:22

我对李的昵称没有问题，只要问我怎么做就行了。是否有任何命令通过autocad visual lisp或我需要另一个程序。是否有任何程序可以帮助我使用dcl，绘制我需要的表格并给我代码？（像visual basic？）

页: [1] 2

乐筑天下's Archiver

DCL和Lisp的帮助