图层和标注Lisp 乐筑天下 - Powered by Discuz! Archiver

camel_racer 发表于 2022-7-6 10:47:31

图层和标注Lisp

这是一个相当大的问题，但我想知道是否有人知道一个lisp程序（或如何编写一个）可以使用选定的块名在图形中生成图层列表。
i、 e.我选择2个块（称为Block1和Block2）并按下按钮，然后用这个名称创建2个层？。。如果它们也可以移动到该层上，那将非常有用。

&我的第二个问题（可能更大）是，有没有可能创建一些东西，在某一层的每一行旁边放置一个数字，其尺寸以米为单位？。。。
i、 e.如果我在“Layer1”上画了一个3m x 3m的正方形，我然后按下一个按钮&它将把数字“3”放在sqaure上每条线的外侧。

这两个大请求，但任何帮助（或在正确的方向推动）将不胜感激。

Tharwat 发表于 2022-7-6 10:55:08

你好
该Lisp将采用选定块的名称，并创建一个包含块名称的层
块层将是当前的、连续的和红色的。
(defun c:blk (/ Ent BlkEnt blkNme )
(setq Ent (car(entsel "\n Select a Block: "))
BlkEnt (entget Ent)
BlkNme (cdr (assoc 2 BlkEnt))
)
(vl-cmdf "_.-layer" "_m" BlkNme "ltype" "continuous" "" "color" "red" "" "")
(setvar "clayer" BlkNme)
(princ)
)

当做

塔瓦特

camel_racer 发表于 2022-7-6 11:08:04

太棒了谢谢有什么方法可以让我分组选择几个街区吗？

Lee Mac 发表于 2022-7-6 11:11:10

这应该快得多：

(defun c:Blk2lay ( / ss )
;; © Lee Mac 2010

(if (setq ss (ssget '((0 . "INSERT"))))
(
(lambda ( i / e done )
   (while (setq e (ssname ss (setq i (1+ i))))
      (if (not (member (cdr (assoc 2 (entget e))) done))
      (progn
         (entmake
            (list
            (cons 0 "LAYER")
            (cons 100 "AcDbSymbolTableRecord")
            (cons 100 "AcDbLayerTableRecord")
            (assoc 2 (entget e))
            (cons 70 0)
            )
         )
         (setq done (cons (cdr (assoc 2 (entget e))) done))
      )
      )
      (entupd
      (cdr
         (assoc -1
            (entmod
            (subst
               (cons 8 (cdr (assoc 2 (entget e))))
               (assoc 8 (entget e))
               (entget e)
            )
            )
         )
      )
      )
   )
)
-1
)
)
(princ)
)

camel_racer 发表于 2022-7-6 11:20:50

太棒了！。。。真是太棒了！。。谢谢大家！

Lee Mac 发表于 2022-7-6 11:29:19

非常欢迎你参加Camel_Racer。

alanjt 发表于 2022-7-6 11:35:11

仅供参考，当您对图层使用“生成”选项时，创建的图层将设置为当前图层。不需要担心设置clayer变量。

BIGAL 发表于 2022-7-6 11:42:38

直线或柱脚的自动尺寸标注非常简单，只需列出直线并获取其长度，然后将文本放在中点即可。

困难的部分是让文本在每行的正确一侧，您可能需要为每行输入“是”或“否”。

这是一个很老的问题，但一个很好的起点为你提供了创建自己的问题的大部分答案。

;SETOUT3.LSP
; program to draw setout details as a co-ord list
; with co-ords to two points
; 29/7/01 by alan
(setvar "menuecho" 0)
(setvar "SNAPMODE" 0)
(COMMAND "STYLE" "MYDEFAULT" "ISO3098b" 0.0 1.0 0.0 "N" "N" "N")
(setq oldangbase (getvar "angbase"))
(setq oldangdir (getvar "angdir"))
(setq oldaunits (getvar "aunits"))
(setvar "angbase" 0.0)
(setvar "angdir" 0)
(setvar "aunits" 3)
(SETQ SETSC (GETREAL "\nWhat is overall scale 1 ?"))
(SETQ TXTHT (* 1.75 setsc)) ;CHANGE TO ASK FOR FINAL PLOT SCALE
(while
(SETVAR "OSMODE" 1)
(setq pt1 (getpoint "\nPick 1st point, press <cr> to exit"))
(setq pt2 (getpoint "\nPick next point, press <cr> to exit"))
(SETQ DIST (DISTANCE PT1 PT2))
(SETQ DISTMID (/ DIST 2.0))
(SETQ ANG (ANGLE PT1 PT2))
(setq pt3 (polar pt1 ANG DISTMID))
(setq pt3 (polar pt3 (+ ang 1.5707) 1.5))
(SETQ BLOCKLEN (RTOS DIST 2 2))
(SETVAR "OSMODE" 0)
(command "text" "MC" pt3 txtht ANG BLOCKLEN)
(setq flip (getstring "\nFlip text 180 press f"))
(if (or (= flip "f")(= flip "F"))
(command "rotate" "l" "" pt3 3.14159)
)
) ; end while
(setvar "angbase" oldangbase )
(setvar "angdir" oldangdir)
(setvar "aunits" oldaunits)

(setq pt1 nil
pt2 nil
pt3 nil
pt4 nil
pt5 nil
pt6 nil
stpt nil
ans nil
)
(princ)

今天还有另一篇关于文字到行的帖子。

camel_racer 发表于 2022-7-6 11:47:44

谢谢你的邀请。。。这对我来说应该足够屠宰了

页: [1]

乐筑天下's Archiver

图层和标注Lisp