我需要一些帮助，创建选项卡

Michalis · 发表于 2022-7-6 07:57:18

大家好，
我是新来的，我需要一些帮助，
我想画一条线，（它是一种剖面），然后应该用多段线或带计数的线图层生成一个表，我已经用Mechanical using Section和dx完成了，但我需要用lisp更快，我可以用table或block，所以当我插入它时，应该需要第一个点，然后是第二个点，并在一个带计数的框中给我所有图层名称，
请原谅我的英语，
请参见下图

Tharwat · 发表于 2022-7-6 08:02:09

欢迎来到Cadtutor

这一节是关于什么的？它由什么组成？

如果你用英语展示表格，大家都会看得更清楚

你能上传那个部分的图纸吗？

Michalis · 发表于 2022-7-6 08:06:48

你说得对，这是一个新的英文截图，
故事是这样的，
我为我使用的每根电缆使用层名称，例如，NYY 5x10mm2是层名称，NYY 5x10mm2也是，
根据我的图纸，从A-B中，我有许多电缆，9FTP Cat5 1NYY 5x10，1NYY 3x120+70+1x90mm2 2NYY 5x16等，因此，我想选择2点（A-B），例如，
第二幅图显示了所有通过2个点（模型空间）的线，所以现在我必须从一个检修孔到另一个检修孔，向工作现场的伙计们演示，并告诉他们管道将如何进行，

截面是一条简单的多段线，与其他多段线相交，

Lee Mac · 发表于 2022-7-6 08:09:15

这应该让你开始：

copy


([color=BLUE]defun[/color] c:LineCount ( [color=BLUE]/[/color] a b i l p q s )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] p ([color=BLUE]getpoint[/color] [color=MAROON]"\nPick 1st Point: "[/color]))
           ([color=BLUE]setq[/color] q ([color=BLUE]getpoint[/color] [color=MAROON]"\nPick 2nd Point: "[/color] p))
       )
       ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_F"[/color] ([color=BLUE]list[/color] p q) '((0 . [color=MAROON]"*LINE"[/color]))))
           ([color=BLUE]progn[/color]
               ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
                   ([color=BLUE]setq[/color] a ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 8 ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))))))
                   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] b ([color=BLUE]assoc[/color] a l))
                       ([color=BLUE]setq[/color] l ([color=BLUE]subst[/color] ([color=BLUE]list[/color] a ([color=BLUE]1+[/color] ([color=BLUE]cadr[/color] b))) b l))
                       ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color]  ([color=BLUE]list[/color] a 1) l))
                   )
               )
               ([color=BLUE]terpri[/color])
               ([color=BLUE]princ[/color] (LM:PadBetween [color=MAROON]"\nLayer"[/color] [color=MAROON]"Count"[/color] [color=MAROON]"."[/color] 40))
               ([color=BLUE]princ[/color] (LM:PadBetween [color=MAROON]"\n"[/color] [color=MAROON]""[/color] [color=MAROON]"="[/color] 40))
               ([color=BLUE]foreach[/color] x ([color=BLUE]vl-sort[/color] l '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]<[/color] ([color=BLUE]cadr[/color] a) ([color=BLUE]cadr[/color] b))))
                   ([color=BLUE]princ[/color] (LM:PadBetween ([color=BLUE]strcat[/color] [color=MAROON]"\n "[/color] ([color=BLUE]car[/color] x)) ([color=BLUE]itoa[/color] ([color=BLUE]cadr[/color] x)) [color=MAROON]"."[/color] 40))
               )
               ([color=BLUE]textpage[/color])
           )
           ([color=BLUE]princ[/color] [color=MAROON]"\nNo lines found between selected points."[/color])
       )
   )
   ([color=BLUE]princ[/color])
)
[color=GREEN];;---------------------=={ Pad Between }==--------------------;;[/color]
[color=GREEN];;                                                            ;;[/color]
[color=GREEN];;  Returns a string of a minimum specified length which is   ;;[/color]
[color=GREEN];;  the concatenation of two supplied strings padded to a     ;;[/color]
[color=GREEN];;  desired length using a supplied character.                ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
[color=GREEN];;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
[color=GREEN];;  Arguments:                                                ;;[/color]
[color=GREEN];;  s1,s2 - strings to be concatenated                        ;;[/color]
[color=GREEN];;  ch    - character for padding                             ;;[/color]
[color=GREEN];;  ln    - minimum length of returned string                 ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
[color=GREEN];;  Returns:  Concatenation of s1,s2 padded to a min length   ;;[/color]
[color=GREEN];;------------------------------------------------------------;;[/color]
([color=BLUE]defun[/color] LM:PadBetween ( s1 s2 ch ln )
   (
       ([color=BLUE]lambda[/color] ( a b c )
           ([color=BLUE]repeat[/color] ([color=BLUE]-[/color] ln ([color=BLUE]length[/color] b) ([color=BLUE]length[/color] c)) ([color=BLUE]setq[/color] c ([color=BLUE]cons[/color] a c)))
           ([color=BLUE]vl-list->string[/color] ([color=BLUE]append[/color] b c))
       )
       ([color=BLUE]ascii[/color] ch)
       ([color=BLUE]vl-string->list[/color] s1)
       ([color=BLUE]vl-string->list[/color] s2)
   )
)

Michalis · 发表于 2022-7-6 08:10:31

喜欢它！
但是..！！：-）
如何在绘图时显示我选择的点？我想展示一下我从哪一点找到了这些数据？

这是一个通过我决定的点的多段线的报告，我希望我现在可以给你更多的例子，我在工作，我在思考如何使它从清晨！！！

Tharwat · 发表于 2022-7-6 08:15:47

我的版本和我的方式。。。。

copy


(defun c:Test (/ entities i number integer layers lst object point1
              point2 result selectionset selectionsetname singlelayer
             )
 ;;; Tharwat 15. May. 2012 ;;;
 (if (and (setq point1 (getpoint "\n Specify first point :"))
          (setq point2 (getpoint point1 "\n Specify Second point :"))
          (setq selectionset
                 (ssget "_F"
                        (list point1 point2)
                        '((0 . "LINE,*POLYLINE"))
                 )
          )
     )
   (progn
     (repeat (setq integer (sslength selectionset))
       (setq entities (cons (setq selectionsetname
                                   (ssname
                                     selectionset
                                     (setq integer (1- integer))
                                   )
                            )
                            entities
                      )
       )
       (if (not (member (setq singlelayer
                               (cdr (assoc 8 (entget selectionsetname)))
                        )
                        layers
                )
           )
         (setq layers (cons singlelayer layers))
       )
     )
     (setq i 0)
     (foreach layer layers
       (repeat (setq number (length entities))
         (if
           (eq
             (cdr
               (assoc 8
                      (entget (nth (setq number (1- number)) entities))
               )
             )
             layer
           )
            (setq lst (cons layer (setq i (1+ i))))
         )
       )
       (setq result (cons lst result))
       (setq i 0)
     )
   )
 )
 (foreach one (reverse result)
   (print one)
 )
 (textpage)
 (princ)
)

Tharwat · 发表于 2022-7-6 08:17:19

这张桌子更好。

copy

(defun c:Test (/ entities i number integer layers lst object point1 p
              height point2 result selectionset selectionsetname
              singlelayer model table r c inc
             )
 (vl-load-com)
;;; Tharwat 15. May. 2012 ;;;
 (if (and (setq point1 (getpoint "\n Specify first point :"))
          (setq point2 (getpoint point1 "\n Specify Second point :"))
          (setq selectionset
                 (ssget "_F"
                        (list point1 point2)
                        '((0 . "LINE,*POLYLINE"))
                 )
          )
          (setq p (getpoint "\n Table insertion point :"))
     )
   (progn
     (setq height (if (zerop (cdr (assoc 40
                                         (setq st
                                                (entget
                                                  (tblobjname "STYLE" (getvar 'textstyle))
                                                )
                                         )
                                  )
                             )
                      )
                    (cdr (assoc 42 st))
                    (cdr (assoc 40 st))
                  )
     )
     (repeat (setq integer (sslength selectionset))
       (setq entities (cons (setq selectionsetname
                                   (ssname
                                     selectionset
                                     (setq integer (1- integer))
                                   )
                            )
                            entities
                      )
       )
       (if (not (member (setq singlelayer
                               (cdr (assoc 8 (entget selectionsetname)))
                        )
                        layers
                )
           )
         (setq layers (cons singlelayer layers))
       )
     )
     (setq i 0)
     (foreach layer layers
       (repeat (setq number (length entities))
         (if
           (eq
             (cdr
               (assoc 8
                      (entget (nth (setq number (1- number)) entities))
               )
             )
             layer
           )
            (setq lst (cons layer (setq i (1+ i))))
         )
       )
       (setq result (cons lst result))
       (setq i 0)
     )
     (setq model (vla-get-modelspace
                   (vla-get-activedocument (vlax-get-acad-object))
                 )
     )
     (setq table (vla-addtable
                   model
                   (vlax-3d-point p)
                   (1+ (length result))
                   2
                   (* height 2.)
                   (* height 10.)
                 )
     )
     (vla-settext table 0 0 "Section A - B")
     (setq r   0
           c   0
           inc -1
     )
     (repeat (length result)
       (vla-settext
         table
         (setq r (1+ r))
         c
         (car (nth (setq inc (1+ inc)) result))
       )
       (vla-settext
         table
         r
         (setq c (1+ c))
         (itoa (cdr (nth inc result)))
       )
       (setq c 0)
     )
   )
 )
 (princ)
)

fixo · 发表于 2022-7-6 08:22:11

除第一个代码外：

copy

 
(defun c:LineCount ( / a acsp adoc b col cols i ip l num p q row rows s tbl tmp)
(vl-load-com)
(if
(and
(setq p (getpoint "\nPick 1st Point: "))
(setq q (getpoint "\nPick 2nd Point: " p))
)
(if (setq s (ssget "_F" (list p q) '((0 . "*LINE"))))
(progn
(repeat (setq i (sslength s))
(setq a (cdr (assoc 8 (entget (ssname s (setq i (1- i)))))))
(if (setq b (assoc a l))
(setq l (subst (list a (1+ (cadr b))) b l))
(setq l (cons (list a 1) l))
)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
acsp (vla-get-block (vla-get-activelayout adoc))
) 
(setq l (vl-sort l '(lambda ( a b ) (< (cadr a) (cadr b)))))
(setq l (mapcar 'reverse l))
(setq ip (getpoint "\nPick table position: "))
(setq tbl (vlax-invoke acsp 'addtable ip (+ (length l) 1) (length (car l)) 25.0 250.0))
(vla-put-regeneratetablesuppressed tbl :vlax-true)
(vla-settext tbl 0 0 "Section [url="file://c3;a-b/"]\\C3;A-B[/url]")
(setq row 1)
(setq num (length l))
(setq cols (length (car l)))
(foreach x l 
(setq tmp (car l))
(setq col 0)
(while (< col cols)
(vla-settext tbl row col (nth col x))
(setq col (1+ col))
)
(setq row (1+ row))
)
(setq rows (vla-get-rows tbl))
(vla-settextheight tbl actitlerow 20)
(vla-settextheight tbl (+ acheaderrow acdatarow) 15)
(vla-setcolumnwidth tbl 0 50.)
(vla-setcolumnwidth tbl 1 150.)
(vla-put-regeneratetablesuppressed tbl :vlax-false))
)
(princ "\nNo lines found between selected points.")
)
(princ)
)