社区 › Auto Lisp › 我需要一些帮助，创建选项卡

Michalis 发表于 2022-7-6 08:31:58

有些事情就在我们面前，我们就是看不见！！
 
我在vlide，但出于某种原因，我认为我必须调试它或。。。把它变成Lisp程序的东西。。
 
非常感谢。它真的很管用！！

Tharwat 发表于 2022-7-6 08:34:26

 
很高兴听到这个消息。
 
享受吧，米查利斯

Michalis 发表于 2022-7-6 08:36:44

亲爱的朋友们，让我们更加努力
 
当我第二次使用代码时，A-B应该是C-E，然后是F-G等等。。等
此外，我指定的2个点应该留下一条多段线，并在其上方留一个名称和截面名称，例如
如果我第一次运行它，我指定第一个点，然后是第二个点，
结果应该是，
从第一个点到第二个点的多段线，每个点上方都有A-B字母，表格就这么好，
然后，当我第二次运行它时，我会再次指定第一个点，然后是第二个点，结果应该是：
从第一点到第二点的多段线，上面有C-D字母，
我不知道是否可以在流程开始时选择的点所在的直线上执行箭头（每次运行lsp时的第一个点和第二个点）
 
我相信这对你们来说是小菜一碟

Tharwat 发表于 2022-7-6 08:39:32

 
至少对我来说，这根本不是小菜一碟
 
尽量在右手边指定第一个点，在左手边指定第二个点，以避免文本角度的方向。
 

(defun c:Test (/ entities i number integer layers lst object point1 p st
            height point2 result selectionset selectionsetname
            singlelayer space table r c inc ang
             )
(vl-load-com)
;;; Tharwat 15. May. 2012 ;;;
(if (not char1)
   (setq char1 65
         char2 66
   )
   (setq char1 (+ char1 2)
         char2 (+ char2 2)
   )
)
(if (> char2 90)
   (setq char1 65
         char2 66
   )
)
(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
   (vl-cmdf "_.pline" "_non" point1 "_non" point2 "")
   (setq height (if (zerop (cdr (assoc 40
                                       (setq st
                                                (entget
                                                (tblobjname "STYLE" (getvar 'textstyle))
                                                )
                                       )
                                  )
                           )
                      )
                  (cdr (assoc 42 st))
                  (cdr (assoc 40 st))
                  )
   )
   (entmakex
       (list '(0 . "TEXT")
             (cons 40 (* height 3.))
             (cons 10
                   (polar point1
                        (setq ang (angle point2 point1))
                        (* height 1.
                   )
             )
             (cons 50 ang)
             (cons 1 (chr char1))
       )
   )
   (entmakex
       (list '(0 . "TEXT")
             (cons 40 (* height 3.))
             (cons 10
                   (polar point2
                        (setq ang (angle point1 point2))
                        (* height 3.5)
                   )
             )
             (cons 50 (angle point2 point1))
             (cons 1 (chr char2))
       )
   )
   (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 space (if (> (vla-get-activespace
                        (setq acdoc (vla-get-activedocument
                                        (vlax-get-acad-object)
                                    )
                        )
                        )
                        0
                     )
                   (vla-get-modelspace acdoc)
                   (vla-get-paperspace acdoc)
               )
   )
   (setq table (vla-addtable
                   space
                   (vlax-3d-point p)
                   (1+ (length result))
                   2
                   (* height 2.)
                   (* height 10.)
               )
   )
   (vla-settext
       table
       0
       0
       (strcat "Section " (chr char1) " " (chr 45) " " (chr char2))
   )
   (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-setcellalignment table r c acMiddleCenter)
       (vla-settext
         table
         r
         (setq c (1+ c))
         (itoa (cdr (nth inc result)))
       )
       (vla-setcellalignment table r c acMiddleCenter)
       (setq c 0)
   )
   )
)
(princ)
)

Michalis 发表于 2022-7-6 08:41:39

先生我向你鞠躬！非常感谢你

Tharwat 发表于 2022-7-6 08:44:56

 
不客气，米查利斯。
 
谢谢你的好话。
享受吧，伙计。
 
塔瓦特

stevesfr 发表于 2022-7-6 08:50:37

Tharwat，很好的编程，但插入结果很小。如何修改以使表格更大？
谢谢
史蒂夫

Tharwat 发表于 2022-7-6 08:53:04

 
谢谢你Steve
 
只需从文字样式中增加文字的高度

ReMark 发表于 2022-7-6 08:56:46

我想知道一家公司需要为这种类型的自定义lisp例程支付多少钱？我想知道？嗯。

Tharwat 发表于 2022-7-6 08:58:22

 
我也想知道！

查看完整版本: 我需要一些帮助，创建选项卡