（完成）[编程申请]：高手可否寫個如圖的lisp程式

formz · 发表于 2003-8-29 15:07:02

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

有哪位高手可以寫寫如圖的lisp程式,其中的數值可用dcll輸入

chenhang1203 · 发表于 2003-8-29 15:23:23

看不懂什么意识，你要实现什么功能呢？还有不要用繁（烦）体字。。。

lsjjm · 发表于 2003-8-29 16:14:21

把你的具体要求,已知条件等说清楚?

cnnets · 发表于 2003-8-29 20:48:57

是否是尺寸关联物体之类的？用对话框调数值而改变物体大小？像天正5.0那样？还是。。。能否加段文字详细说明一下，大家也好帮你呀。

e2002 · 发表于 2003-8-29 22:09:30

明白了,运行时先出现对话框,输入d ,D , l 共3个参数,然后点击"Draw"按钮, 对话框隐藏,用户在屏幕上连续点击输入 StartPoint , EndPoint , 右键不选择则返回对话框 ,可以点击"Exit"按钮或调整参数后再次绘制....

可惜我没有时间来帮你作这个...8-(

clty · 发表于 2003-8-29 22:15:44

lihai

formz · 发表于 2003-8-30 23:48:06

是的如 e2002 所說,將其中標註的 (4個) (14,2,2,18) 部分由DCL中輸入

eachy · 发表于 2003-8-31 00:01:46

最初由 formz 发布
[B]是的如 e2002 所說,將其中標註的 (4個) (14,2,2,18) 部分由DCL中輸入 [/B]

对话框的要等几天，不用对话框的话可以快些。

陌生人 · 发表于 2003-8-31 09:17:24

这个用线形来画就可以了

e2002 · 发表于 2003-8-31 13:40:41

编程时需要注意UCS哦....8-)

formz · 发表于 2003-9-6 00:55:03

eachy 兄幫幫忙急需
還有一個單位轉換功能可否有能可幫忙,使用AREA後如何將結果寫在圖上,並有單位
並轉換為台灣的坪(面積單位) 1坪為0.3025 m2

coolzhb · 发表于 2003-9-6 01:15:03

最初由 formz 发布
[B]eachy 兄幫幫忙急需
還有一個單位轉換功能可否有能可幫忙,使用AREA後如何將結果寫在圖上,並有單位
並轉換為台灣的坪(面積單位) 1坪為0.3025 m2 [/B]

写面积的程序论坛有，你搜索一下，命令是ea吧！

eachy · 发表于 2003-9-6 08:17:31

最初由 formz 发布
[B]eachy 兄幫幫忙急需
還有一個單位轉換功能可否有能可幫忙,使用AREA後如何將結果寫在圖上,並有單位
並轉換為台灣的坪(面積單位) 1坪為0.3025 m2 [/B]

先看看置顶帖子的面积标注帖子，有什么不适合的提出来，我再给你定制。

formz · 发表于 2003-9-22 04:04:05

對話框不用了,可否幫幫忙真的等很久

eachy · 发表于 2003-9-22 11:50:10

最初由 formz 发布
[B]對話框不用了,可否幫幫忙真的等很久 [/B]

在工具箱环境下，先用附件覆盖 \XDSoft\Lisp 目录下同名文件。

($xdrx_load "xdlsp.lsp")
(defun c:test (/ pt1 pt2 key lst $h $w $t len
ptl0 ptl00 _p1 _p2 _p3 _p4 _p5 _p6 pangle
n
)
(princ
"\n各参数间以"空格"分隔,格式 (高步长保护厚),回车取默认值!"
)
(initget 128)
(setq key (getstring t
(if $xdtb_e_key
(strcat "\n输入参数<" $xdtb_e_key ">: ")
"\n输入参数: "
)
)
)
(if (/= key "")
(setq $xdtb_e_key key)
(setq key $xdtb_e_key)
)
(setq pt1 (getpoint "\n起点: ")
pt2 (getpoint pt1 "\n终点: ")
)
(if (and pt1 pt2 key)
(progn
(xdrx_begin)
(xdrx_sysvar_push "osmode")
(setvar "osmode" 0)
(setq lst (mapcar 'read (xdrx_string_tok key " ")))
(if (and (not (member 'nil (mapcar 'numberp lst)))
(>= (length lst) 3)
)
(progn
(setq lst (mapcar 'float lst)
$h (car lst)
$w (cadr lst)
$t (last lst)
n (fix (/ (distance pt1 pt2) $w))
pangle (angle pt1 pt2)
len (* n $w)
)
(setq ptl0 (append
(list pt1)
($XDLSP_Points_GetPointWithPath pt1 pangle $w n)
)
_p1 (polar pt1 (- pangle _pi2) $t)
_p2 (polar _p1 pangle (distance pt1 pt2))
_p3 (polar pt1 (+ pangle _pi2) $h)
_p4 (polar _p3 pangle (distance pt1 pt2))
_p5 (polar _p3 (angle pt1 _p3) $t)
_p6 (polar _p5 pangle (distance pt1 pt2))
ptl00 (append (list _p3)
($XDLSP_Points_GetPointWithPath
_p3
pangle
$w
n
)
)
)
(xdrx_line1 pt1 pt2)
(xdrx_line1 _p1 _p2)
(xdrx_line1 _p3 _p4)
(xdrx_line1 _p5 _p6)
(mapcar '(lambda (x y) (xdrx_line1 x y))
ptl0
ptl00
)
(mapcar '(lambda (x y)
(xdrx_line1 x y)
)
(reverse (cdr (reverse ptl00)))
(cdr ptl0)
)
(xdrx_dimension_makealign
pt1
_p3
(polar pt1
(+ pangle pi)
(/ $w 2)
)
)
(xdrx_dimension_makealign
(cadr ptl0)
(nth 2 ptl0)
(polar pt1
(angle pt1 _p1)
(/ $h 2)
)
)
)
(princ "\n输入中含有非数字!")
)
(xdrx_sysvar_pop)
(xdrx_end)
)
)
(princ)
)

($xdrx_load "xdlsp.lsp") 
(defun c:test (/     pt1   pt2         key   lst   $h           $w         $t    len 
               ptl0  ptl00 _p1         _p2   _p3   _p4   _p5         _p6   pangle 
               n 
              ) 
  (princ 
    "\n各参数间以"空格"分隔,格式 (高 步长 保护厚),回车取默认值!" 
  ) 
  (initget 128) 
  (setq        key (getstring t 
                       (if $xdtb_e_key 
                         (strcat "\n输入参数<" $xdtb_e_key ">: ") 
                         "\n输入参数: " 
                       ) 
            ) 
  ) 
  (if (/= key "") 
    (setq $xdtb_e_key key) 
    (setq key $xdtb_e_key) 
  ) 
  (setq        pt1 (getpoint "\n起点: ") 
        pt2 (getpoint pt1 "\n终点: ") 
  ) 
  (if (and pt1 pt2 key) 
    (progn 
      (xdrx_begin) 
      (xdrx_sysvar_push "osmode") 
      (setvar "osmode" 0) 
      (setq lst (mapcar 'read (xdrx_string_tok key " "))) 
      (if (and (not (member 'nil (mapcar 'numberp lst))) 
               (>= (length lst) 3) 
          ) 
        (progn 
          (setq        lst    (mapcar 'float lst) 
                $h     (car lst) 
                $w     (cadr lst) 
                $t     (last lst) 
                n      (fix (/ (distance pt1 pt2) $w)) 
                pangle (angle pt1 pt2) 
                len    (* n $w) 
          ) 
          (setq        ptl0  (append 
                        (list pt1) 
                        ($XDLSP_Points_GetPointWithPath pt1 pangle $w n) 
                      ) 
                _p1   (polar pt1 (- pangle _pi2) $t) 
                _p2   (polar _p1 pangle (distance pt1 pt2)) 
                _p3   (polar pt1 (+ pangle _pi2) $h) 
                _p4   (polar _p3 pangle (distance pt1 pt2)) 
                _p5   (polar _p3 (angle pt1 _p3) $t) 
                _p6   (polar _p5 pangle (distance pt1 pt2)) 
                ptl00 (append (list _p3) 
                              ($XDLSP_Points_GetPointWithPath 
                                _p3 
                                pangle 
                                $w 
                                n 
                              ) 
                      ) 
          ) 
          (xdrx_line1 pt1 pt2) 
          (xdrx_line1 _p1 _p2) 
          (xdrx_line1 _p3 _p4) 
          (xdrx_line1 _p5 _p6) 
          (mapcar '(lambda (x y) (xdrx_line1 x y)) 
                  ptl0 
                  ptl00 
          ) 
          (mapcar '(lambda (x y) 
                     (xdrx_line1 x y) 
                   ) 
                  (reverse (cdr (reverse ptl00))) 
                  (cdr ptl0) 
          ) 
          (xdrx_dimension_makealign 
            pt1 
            _p3 
            (polar pt1 
                   (+ pangle pi) 
                   (/ $w 2) 
            ) 
          ) 
          (xdrx_dimension_makealign 
            (cadr ptl0) 
            (nth 2 ptl0) 
            (polar pt1 
                   (angle pt1 _p1) 
                   (/ $h 2) 
            ) 
          ) 
        ) 
        (princ "\n输入中含有非数字!") 
      ) 
      (xdrx_sysvar_pop) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
)

账号		自动登录	找回密码
密码			立即注册

（完成）[编程申请]：高手可否寫個如圖的lisp程式

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

re

Re: re

浏览过的版块