生成

abc498091367 · 发表于 2014-3-9 14:23:31

st788796 发表于 2014-3-9 12:37
重新复制下载

现在程序正常执行,可以统计出来,但是统计出来的ABC这样的符号在一起. QQ图片20140309142318.jpg

st788796 · 发表于 2014-3-9 14:55:11

写字语句少了一个
(setq p (mapcar '+ p v))

abc498091367 · 发表于 2014-3-9 18:01:21

st788796 发表于 2014-3-9 14:55
写字语句少了一个
(setq p (mapcar '+ p v))

程序可能还要优化一下

分出来的效果是这样的.

AB是一样,CDE都是一样的,现在分开了.

右边的统计有问题.麻烦ST788796了.

st788796 · 发表于 2014-3-9 18:30:38

abc498091367 发表于 2014-3-9 18:01
程序可能还要优化一下

分出来的效果是这样的.

调整分组精度试试把1e-3 改成 1

abc498091367 · 发表于 2014-3-10 08:57:06

st788796 发表于 2014-3-9 18:30
调整分组精度试试把1e-3 改成 1

ST大,我把1e-3 改成 1了,结果是这样的,下面应该3个一样,上面2个一样.

st788796 · 发表于 2014-3-10 09:04:32

abc498091367 发表于 2014-3-10 08:57
ST大,我把1e-3 改成 1了,结果是这样的,下面应该3个一样,上面2个一样.

发个图上来,另外你的图形肯定是复制的?

abc498091367 · 发表于 2014-3-10 09:14:22

st788796 发表于 2014-3-10 09:04
发个图上来,另外你的图形肯定是复制的?

图形肯定复制，你可以下载下面的文件，看看！！！

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:Drawing2.zip
下载次数:2 文件大小:89.68 KB
下载权限: 不限以上 [免费赚D豆]

st788796 · 发表于 2014-3-10 09:26:48

abc498091367 发表于 2014-3-10 09:14
图形肯定复制，你可以下载下面的文件，看看！！！

累计位置搞错了

(defun c:tt (/ ss lst i)
(if (setq ss (ssget '((0 . "*polyline"))))
(progn
(setq lst (mapcar '(lambda (x / bp)
(setq bp (car (xdrx_entity_box x)))
(list (mapcar '(lambda (p)
(mapcar '- p bp)
)
(xdrx_entity_getstretchpoint x)
)
x
)
)
(xdrx_pickset->ents ss)
)
lst (xd::list:groupbyindex lst 1)
lst (mapcar 'cdr lst)
i 64 ;_编号数量不大於 52 个 A-Z a-z
lst (mapcar '(lambda (x / box p)
(if (> 97 i 90)
(setq i 96)
)
(setq i (1+ i))
(mapcar '(lambda (a)
(setq box (xdrx_entity_box a)
p (xdrx_line_midp (car box) (caddr box))
)
(xdrx_text_make
p
(chr i)
(getvar "textsize")
0.
)
)
x
)
(list (chr i) (length (cdr x)))
)
lst
)
)
(if (setq p (getpoint "\nOutput Point: "))
(progn
(setq v (list 0. (- (* 1.5 (getvar "textsize"))) 0.))
(mapcar '(lambda (x)
(xdrx_text_make
p
(vl-string-trim "()" (vl-princ-to-string x))
(getvar "textsize")
0.
)
(setq p (mapcar '+ p v))
)
lst
)
)
(foreach x lst
(princ "\n")
(princ x)
)
)
)
)
(princ)
)

(defun c:tt (/ ss lst i) 
  (if (setq ss (ssget '((0 . "*polyline")))) 
    (progn 
      (setq lst        (mapcar        '(lambda (x / bp) 
                           (setq bp (car (xdrx_entity_box x))) 
                           (list (mapcar '(lambda (p) 
                                            (mapcar '- p bp) 
                                          ) 
                                         (xdrx_entity_getstretchpoint x) 
                                 ) 
                                 x 
                           ) 
                         ) 
                        (xdrx_pickset->ents ss) 
                ) 
            lst        (xd::list:groupbyindex lst 1) 
            lst        (mapcar 'cdr lst) 
            i        64 ;_编号数量不大於 52 个 A-Z a-z 
            lst        (mapcar        '(lambda (x / box p) 
                           (if (> 97 i 90) 
                             (setq i 96) 
                           ) 
                           (setq i (1+ i)) 
                           (mapcar '(lambda (a) 
                                      (setq box        (xdrx_entity_box a) 
                                            p        (xdrx_line_midp (car box) (caddr box)) 
                                      ) 
                                      (xdrx_text_make 
                                        p 
                                        (chr i) 
                                        (getvar "textsize") 
                                        0. 
                                      ) 
                                    ) 
                                   x 
                           ) 
                           (list (chr i) (length (cdr x))) 
                         ) 
                        lst 
                ) 
      ) 
      (if (setq p (getpoint "\nOutput Point: ")) 
        (progn 
          (setq v (list 0. (- (* 1.5 (getvar "textsize"))) 0.)) 
          (mapcar '(lambda (x) 
                     (xdrx_text_make 
                       p 
                       (vl-string-trim "()" (vl-princ-to-string x)) 
                       (getvar "textsize") 
                       0. 
                     ) 
                     (setq p (mapcar '+ p v)) 
                   ) 
                  lst 
          ) 
        ) 
        (foreach x lst 
          (princ "\n") 
          (princ x) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

abc498091367 · 发表于 2014-3-10 09:31:26

st788796 发表于 2014-3-10 09:26
累计位置搞错了

现在符号这边没问题，统计出来的数量，还有错误。你看看图片！！！全部都少1个
QQ图片20140310093031.jpg

st788796 · 发表于 2014-3-10 10:19:58

(list (chr i) (length (cdr x)))
=>
(list (chr i) (length x))

abc498091367 · 发表于 2014-3-10 10:43:26

st788796 发表于 2014-3-10 10:19
(list (chr i) (length (cdr x)))
=>
(list (chr i) (length x))

现在程序OK，非常感谢ST

abc498091367 · 发表于 2014-3-10 15:56:45

abc498091367 发表于 2014-3-10 10:43
现在程序OK，非常感谢ST

还请ST大帮下,现在我把符号和数量加上去了.再原来的程序怎么加几个格式?
对好上面的的数量,在一排直线上

st788796 · 发表于 2014-3-10 16:20:28

abc498091367 发表于 2014-3-10 15:56
还请ST大帮下,现在我把符号和数量加上去了.再原来的程序怎么加几个格式?
对好上面的的数量,在一排直线上 ...

稍等写个Table函数

st788796 · 发表于 2014-3-10 17:44:00

;;str -- string
;;h -- height
;;scl -- 宽度比例
(defun XD::String:ActualWidth (str sty h scl)
(and
(or (not sty)
(= sty "")
(not (tblsearch "style" sty))
)
(setq sty (getvar "textstyle"))
)
(abs (car (apply
'mapcar
(cons '-
(textbox (list (cons 1 str)
(cons 7 sty)
(cons 40 h)
(cons 41 scl)
)
)
)
)
)
)
)
(defun XD::String:MaxActualWidth (strl sty h scl)
(apply 'max
(mapcar '(lambda (x)
(XD::String:ActualWidth x sty h scl)
)
strl
)
)
)
(defun XD::Table:Make (lst p RowHeight height
/ tb i _ColumnWidths
_widthL _spa
)
(defun _ColumnWidths (lst h / mL nl)
(setq mL (apply 'max (mapcar 'length lst))
nL (mapcar '(lambda (x)
(XD::List:FillGap x " " mL)
)
lst
)
)
(mapcar '(lambda (x)
(XD::String:MaxActualWidth x "" h 1.)
)
(apply 'mapcar (cons 'list nL))
)
)
(if (or (null height) (= height ""))
(setq height (* RowHeight 0.4))
)
(setq tb (xdrx_table_make
p
(1+ (length lst))
RowHeight
(apply 'max (mapcar 'length lst))
10.
)
_WidthL (_ColumnWidths lst height)
_spa (* 4 (xdrx_table_horzCellMargin tb))
)
(XD::Table:Begin tb)
(xdrx_entity_scale tb p 0.1)
(setq i -1)
(mapcar '(lambda (x)
(xdrx_table_setcolumnwidth tb (setq i (1+ i)) x)
)
(mapcar '(lambda (a) (+ _spa a)) _WidthL)
)
(xdrx_table_setrowheight tb RowHeight)
(xdrx_table_settextheight tb 7 height)
(xdrx_table_setalignment tb 1 5)
(xdrx_table_SetGridVisibility tb 2 41 nil)
(setq i 0)
(mapcar
'(lambda (x / j)
(setq j -1
i (1+ i)
)
(mapcar '(lambda (a)
(xdrx_table_settextstring tb i (setq j (1+ j)) a)
)
x
)
)
lst
)
(XD::Table:End tb)
tb
)
(defun c:tt (/ ss lst i)
(princ "\n选择多义线.....")
(if (setq ss (ssget '((0 . "*polyline"))))
(progn
(setq lst (mapcar '(lambda (x / bp)
(setq bp (car (xdrx_entity_box x)))
(list (mapcar '(lambda (p)
(mapcar '- p bp)
)
(xdrx_entity_getstretchpoint x)
)
x
)
)
(xdrx_pickset->ents ss)
)
lst (xd::list:groupbyindex lst 1)
lst (mapcar 'cdr lst)
i 64 ;_编号数量不大於 52 个 A-Z a-z
lst (mapcar '(lambda (x / box p)
(if (> 97 i 90)
(setq i 96)
)
(setq i (1+ i))
(mapcar '(lambda (a)
(setq box (xdrx_entity_box a)
p (xdrx_line_midp (car box) (caddr box))
)
(xdrx_text_make
p
(chr i)
(getvar "textsize")
0.
)
)
x
)
(list (chr i) (length x))
)
lst
)
)
(if (setq p (getpoint "\n插入点<回车显示>: "))
(XD::Table:make
(cons '("编号" "数量")
(mapcar '(lambda (x) (mapcar 'vl-princ-to-string x)) lst)
)
p
8.
3.
)
(foreach x lst
(princ "\n")
(princ x)
)
)
)
)
(princ)
)

;;str -- string 
;;h   -- height 
;;scl -- 宽度比例 
(defun XD::String:ActualWidth (str sty h scl) 
  (and 
    (or        (not sty) 
        (= sty "") 
        (not (tblsearch "style" sty)) 
    ) 
    (setq sty (getvar "textstyle")) 
  ) 
  (abs (car (apply 
              'mapcar 
              (cons '- 
                    (textbox (list (cons 1 str) 
                                   (cons 7 sty) 
                                   (cons 40 h) 
                                   (cons 41 scl) 
                             ) 
                    ) 
              ) 
            ) 
       ) 
  ) 
) 
(defun XD::String:MaxActualWidth (strl sty h scl) 
  (apply 'max 
         (mapcar '(lambda (x) 
                    (XD::String:ActualWidth x sty h scl) 
                  ) 
                 strl 
         ) 
  ) 
) 
(defun XD::Table:Make (lst         p           RowHeight height 
                       /         tb           i             _ColumnWidths 
                       _widthL         _spa 
                      ) 
  (defun _ColumnWidths (lst h / mL nl) 
    (setq mL (apply 'max (mapcar 'length lst)) 
          nL (mapcar '(lambda (x) 
                        (XD::List:FillGap x " " mL) 
                      ) 
                     lst 
             ) 
    ) 
    (mapcar '(lambda (x) 
               (XD::String:MaxActualWidth x "" h 1.) 
             ) 
            (apply 'mapcar (cons 'list nL)) 
    ) 
  ) 
  (if (or (null height) (= height "")) 
    (setq height (* RowHeight 0.4)) 
  ) 
  (setq        tb        (xdrx_table_make 
                  p 
                  (1+ (length lst)) 
                  RowHeight 
                  (apply 'max (mapcar 'length lst)) 
                  10. 
                ) 
        _WidthL        (_ColumnWidths lst height) 
        _spa        (* 4 (xdrx_table_horzCellMargin tb)) 
  ) 
  (XD::Table:Begin tb) 
  (xdrx_entity_scale tb p 0.1) 
  (setq i -1) 
  (mapcar '(lambda (x) 
             (xdrx_table_setcolumnwidth tb (setq i (1+ i)) x) 
           ) 
          (mapcar '(lambda (a) (+ _spa a)) _WidthL) 
  ) 
  (xdrx_table_setrowheight tb RowHeight) 
  (xdrx_table_settextheight tb 7 height) 
  (xdrx_table_setalignment tb 1 5) 
  (xdrx_table_SetGridVisibility tb 2 41 nil) 
  (setq i 0) 
  (mapcar 
    '(lambda (x / j) 
       (setq j -1 
             i (1+ i) 
       ) 
       (mapcar '(lambda        (a) 
                  (xdrx_table_settextstring tb i (setq j (1+ j)) a) 
                ) 
               x 
       ) 
     ) 
    lst 
  ) 
  (XD::Table:End tb) 
  tb 
) 
(defun c:tt (/ ss lst i) 
  (princ "\n选择多义线.....") 
  (if (setq ss (ssget '((0 . "*polyline")))) 
    (progn 
      (setq lst        (mapcar        '(lambda (x / bp) 
                           (setq bp (car (xdrx_entity_box x))) 
                           (list (mapcar '(lambda (p) 
                                            (mapcar '- p bp) 
                                          ) 
                                         (xdrx_entity_getstretchpoint x) 
                                 ) 
                                 x 
                           ) 
                         ) 
                        (xdrx_pickset->ents ss) 
                ) 
            lst        (xd::list:groupbyindex lst 1) 
            lst        (mapcar 'cdr lst) 
            i        64 ;_编号数量不大於 52 个 A-Z a-z 
            lst        (mapcar        '(lambda (x / box p) 
                           (if (> 97 i 90) 
                             (setq i 96) 
                           ) 
                           (setq i (1+ i)) 
                           (mapcar '(lambda (a) 
                                      (setq box        (xdrx_entity_box a) 
                                            p        (xdrx_line_midp (car box) (caddr box)) 
                                      ) 
                                      (xdrx_text_make 
                                        p 
                                        (chr i) 
                                        (getvar "textsize") 
                                        0. 
                                      ) 
                                    ) 
                                   x 
                           ) 
                           (list (chr i) (length x)) 
                         ) 
                        lst 
                ) 
      ) 
      (if (setq p (getpoint "\n插入点<回车显示>: ")) 
        (XD::Table:make 
          (cons        '("编号" "数量") 
                (mapcar '(lambda (x) (mapcar 'vl-princ-to-string x)) lst) 
          ) 
          p 
          8. 
          3. 
        ) 
        (foreach x lst 
          (princ "\n") 
          (princ x) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

abc498091367 · 发表于 2014-3-10 19:40:50

st788796 发表于 2014-3-10 17:44

插入点<回车显示>: ; 错误: no function definition: XDRX_TABLE_MAKE

XDRX_TABLE_MAKE函数没有？

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

[求助] 生成

点评