hhh454 发表于 2010-11-9 10:29:00

[求助] 请帮忙写一个lisp获得pline线的分段长度

本帖最后由 作者 于 2010-11-9 16:35:58 编辑 <br /><br /> <font face="Verdana">请帮忙写一个lisp获得pline线的分段长度，并把每个得到的数据，按顺序变成变量，第一段的长度为a，二段b,等等，最终的目的是想做一个等高矩形的命令，不需要对话框。每个矩形之间有一定的距离</font>

Gu_xl 发表于 2010-11-9 16:45:00

没有对话框的！

(defun c:tt()
(setq osmode (getvar "osmode")
cla (getvar "clayer"))
(setvar "osmode" 0)
(setq Height (getreal "\n输入高度：")
jj (getreal "\n输入间距："))
(princ "\n选择多段线")
(setq en (entsel))
(setq p0 (cadr en)
en (car en)
)
(setq la (cdr (assoc 8 (entget en))))
(setvar "clayer" la)
(setq pt (getpoint p0 "\n标注位置："))
(setq endPara (vlax-curve-getEndParam en)
n 0)
(repeat (fix endPara)
    (setq d (distance (vlax-curve-getPointAtParam en n) (vlax-curve-getPointAtParam en (setq n (1+ n)))))
    (command "_.rectang" pt (strcat "@" (rtos d 2) "," (rtos Height 2)))
    (setq pt (polar pt 0 (+ d jj)))
    )
(setvar "osmode" osmode)
(setvar "clayer" cla)
(princ)
)

Gu_xl 发表于 2010-11-9 19:50:00

本帖最后由 作者 于 2010-11-10 8:38:44 编辑

有对话框的！

(defun c:tt(/ jj height)
(defun gxl-chkreal (a *key*)
      (setq a (read a))
      (if (or (= 'INT (type a)) (= 'REAL (type a)))
            (progn
               (setq chk_flag t)
               (setq a a)
               );progn
            (progn
               (alert "\请输入实型数!")
               (mode_tile *key* 2)
               (setq chk_flag nil)
               );progn
         );if
       )
(setq fn (vl-filename-mktemp "aa.dcl"))
(setq f (open fn "w"))
(write-line "getdata:dialog{" f)
(write-line   "label = \" 【等高矩形】\";" f)
(write-line ":boxed_column {" f)
(write-line "label = \"\";" f)
(write-line ": edit_box {" f)
(write-line "key = \"height\";" f)
(write-line "value = 500.00;" f)
(write-line "label = \"高度\";" f)
(write-line       "width = 20;" f)
(write-line            "}" f)
(write-line ": edit_box {" f)
(write-line "key = \"jj\";" f)
(write-line "value = 30.00;" f)
(write-line "label = \"间隔\";" f)
(write-line       "width = 20;" f)
(write-line         " }" f)
(write-line "}" f)
(write-line   "ok_cancel;" f)
(write-line "}" f)
(close f)
    (setq dlg_code (load_dialog fn))
    (new_dialog "getdata" dlg_code)
(setq height 500.0 jj 30.0)
(Action_tile "height" "(setq height (gxl-chkreal $value $key))")
      (Action_tile "jj" "(setq jj (gxl-chkreal $value $key))")
(mode_tile "height" 2)
    (setq ecode (start_dialog))
   (if (= 1 ecode)
       (progn
(setq osmode (getvar "osmode")
cla (getvar "clayer"))
(setvar "osmode" 0)
(princ "\n选择多段线")
(while (not (and (setq en (entsel)) (= "LWPOLYLINE" (cdr (assoc 0 (entget (car en)))))))
    (princ "\n你选择的不是多段线，请重新选择多段线")
    )
(setq p0 (cadr en)
en (car en)
)
(setq la (cdr (assoc 8 (entget en))))
(setvar "clayer" la)
(setq pt (getpoint p0 "\n标注位置："))
(setq endPara (vlax-curve-getEndParam en)
n 0)
(repeat (fix endPara)
    (setq d (distance (vlax-curve-getPointAtParam en n) (vlax-curve-getPointAtParam en (setq n (1+ n)))))
    (if (> d 0)
      (progn
    (command "_.rectang" pt (strcat "@" (rtos d 2) "," (rtos Height 2)))
    (setq pt (polar pt 0 (+ d jj)))
    )
      )
    )
(setvar "osmode" osmode)
(setvar "clayer" cla)
(princ)
)
       )
    (vl-file-deletefn)
(princ)
)

hhh454 发表于 2010-11-10 11:55:00

<p>谢谢，万分感谢，</p>

669423907 发表于 2011-6-7 13:21:02

非常好的程序！谢谢版主！

cooolseee 发表于 2011-6-9 15:44:10

谢谢楼主的启发，我有想法了

caoxu123 发表于 2011-6-9 20:09:34

很受启发 学习了！！！！

meja 发表于 2023-6-27 17:58:24

Gu_xl 发表于 2010-11-9 19:50
有对话框的！

这个无法运行，很奇怪啊:'(
页: [1]
查看完整版本: [求助] 请帮忙写一个lisp获得pline线的分段长度