将多段线长度提取到乐筑天下 - Powered by Discuz! Archiver

tamariz 发表于 2022-7-5 17:39:36

将多段线长度提取到

你好我正在寻找一种LISP，它允许选择多条多段线，将其长度提取到属性标记（“长度”）块作为字段，
知道在多段线的每一端是有问题的块（属性标记在哪里）。我找到了一个LISP Lee Mac，但它不符合我的期望，因为我必须逐个选择每个字符串和每个属性。

(defun c:Len2Fld ( / *error* tables doc spc p s q ExitFlag )
(vl-load-com)
(while
(defun *error* ( msg )
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
   (princ (strcat "\n** Error: " msg " **")))
(princ)
)

(setq tables (LM:ss->vla (ssget "_X" '((0 . "ACAD_TABLE")))))

(LM:ActiveSpace 'doc 'spc)

(cond
(
(setq p
   (LM:Selectif
      (lambda ( x )
      (vlax-property-available-p
         (vlax-ename->vla-object x) 'Length
      )
      )
      "\nMétré longeur, Selectionner cable: " nil
   )
)
(setq s
   (strcat "%<\\AcObjProp Object(%<\\_ObjId "
      (LM:GetObjectID doc (vlax-ename->vla-object p)) ">%).Length \\f \"%lu6\">%"
   )
)
(while
   (progn
      (or ExitFlag
      (progn
         (initget "Point")
         (setq p (nentsel "\nSelect Text, MText or Attribute for Result <Exit> : "))
      )
      )

      (cond
      (
         ExitFlag nil
      )
      (
         (vl-consp p)

         (if (wcmatch (cdr (assoc 0 (entget (car p)))) "ATTRIB,*TEXT")
            (vla-put-TextString (vlax-ename->vla-object (car p)) s)
            (princ "\n** Object Must be Text, MText or Attribute **")
         )
      )
      )
   )
)
)
)
(vla-regen doc AcActiveViewport)
(princ)
)
)

(defun LM:ActiveSpace ( *doc *spc )
(set *spc
(if
(or
   (eq AcModelSpace
      (vla-get-ActiveSpace
      (set *doc
         (vla-get-ActiveDocument
            (vlax-get-acad-object)
         )
      )
      )
   )
   (eq :vlax-true (vla-get-MSpace (eval *doc)))
)
(vla-get-ModelSpace (eval *doc))
(vla-get-PaperSpace (eval *doc))
)
)
)

(defun LM:Selectif ( foo str nest / e )
(while
(progn
(setq e (car ((if nest nentsel entsel) str)))

(cond
   (
      (eq 'ENAME (type e))

      (if (not (foo e)) (princ "\n** Invalid Object Selected **"))
   )
)
)
)
e
)

(defun LM:GetObjectID ( doc obj )
(if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
(vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
(itoa (vla-get-Objectid obj))
)
)

(defun LM:ss->vla ( ss )
(if ss
(
(lambda ( i / e l )
   (while (setq e (ssname ss (setq i (1+ i))))
      (setq l (cons (vlax-ename->vla-object e) l))
   )
   l
)
-1
)
)
)
我想减少运算次数，如有任何帮助，将不胜感激。
这是我想要的结果

示例dwg
Cablage VDI 3。图纸

提前谢谢（对不起我的英语）
Cablage VDI 2。图纸

hmsilva 发表于 2022-7-5 17:45:13

你好，塔马里兹，欢迎来到CADTutor！

如果可能，发布一个带有几个多段线和几个块的样例dwg以进行处理。

亨里克

tamariz 发表于 2022-7-5 17:49:00

谢谢
例如，我在上一篇文章中添加了dwg

hmsilva 发表于 2022-7-5 17:51:21

选择洋红色LW多段线。。。

(vl-load-com)
(defun c:demo (/ attlst blk doc en_pt obj ss ss1 ss2 st_pt)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (setq ss (ssget '((0 . "LWPOLYLINE"))))
(repeat (setq i (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i))))
      st_pt (vlax-curve-getStartPoint obj)
      en_pt (vlax-curve-getEndPoint obj)
)
(command "_.zoom" "_C" st_pt "")
(setq ss1 (ssget "_C"
                  (polar st_pt (* 0.25 pi) 0.1)
                  (polar st_pt (* 1.25 pi) 0.1)
                  '((0 . "INSERT") (2 . "RJ45CAT6") (66 . 1))
            )
)
(command "_.zoom" "_C" en_pt "")
(setq ss2 (ssget "_C"
                  (polar en_pt (* 0.25 pi) 0.1)
                  (polar en_pt (* 1.25 pi) 0.1)
                  '((0 . "INSERT") (2 . "RJ45CAT6") (66 . 1))
            )
)
(cond (ss1
         (setq blk (vlax-ename->vla-object (ssname ss1 0)))
      )
      (ss2
         (setq blk (vlax-ename->vla-object (ssname ss2 0)))
      )
)
(if blk
   (progn
      (setq attlst (vlax-invoke blk 'GetAttributes))
      (foreach a attlst
      (if (= (vla-get-TagString a) "LENGTH")
         (vla-put-TextString
            a
            (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                  (LM:GetObjectID doc obj)
                  ">%).Length \\f \"%lu6\">%"
            )
         )
      )
      )
   )
)
)
)
(vla-regen doc AcActiveViewport)
(princ)
)

(defun LM:GetObjectID (doc obj)
(if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
(vlax-invoke-method
(vla-get-Utility doc)
'GetObjectIdString
obj
:vlax-false
)
(itoa (vla-get-Objectid obj))
)
)

亨里克

tamariz 发表于 2022-7-5 17:53:14

太神了谢谢

tamariz 发表于 2022-7-5 17:56:06

Lisp程序很好用
我刚刚添加了两个命令，因为我有一个项目，我的UCS与世界不同

(vl-load-com)
(defun c:demo (/ attlst blk doc en_pt obj ss ss1 ss2 st_pt)
(command "_.ucs" "_world")
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (setq ss (ssget '((0 . "LWPOLYLINE"))))
(repeat (setq i (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i))))
      st_pt (vlax-curve-getStartPoint obj)
      en_pt (vlax-curve-getEndPoint obj)
)
(command "_.zoom" "_C" st_pt "")
(setq ss1 (ssget "_C"
                  (polar st_pt (* 0.25 pi) 0.1)
                  (polar st_pt (* 1.25 pi) 0.1)
                  '((0 . "INSERT") (2 . "etiquetteVDI") (66 . 1))
            )
)
(command "_.zoom" "_C" en_pt "")
(setq ss2 (ssget "_C"
                  (polar en_pt (* 0.25 pi) 0.1)
                  (polar en_pt (* 1.25 pi) 0.1)
                  '((0 . "INSERT") (2 . "etiquetteVDI") (66 . 1))
            )
)
(cond (ss1
         (setq blk (vlax-ename->vla-object (ssname ss1 0)))
      )
      (ss2
         (setq blk (vlax-ename->vla-object (ssname ss2 0)))
      )
)
(if blk
   (progn
      (setq attlst (vlax-invoke blk 'GetAttributes))
      (foreach a attlst
      (if (= (vla-get-TagString a) "LONGUEUR")
         (vla-put-TextString
            a
            (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                  (LM:GetObjectID doc obj)
                  ">%).Length \\f \"%lu6\">%"
            )
         )
      )
      )
   )
)
)
)
(command "UCS" "P")
(vla-regen doc AcActiveViewport)
(princ)
)

(defun LM:GetObjectID (doc obj)
(if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
(vlax-invoke-method
(vla-get-Utility doc)
'GetObjectIdString
obj
:vlax-false
)
(itoa (vla-get-Objectid obj))
)
)

Tharwat 发表于 2022-7-5 18:00:39

我只是想知道，既然你在第一篇文章的视频中有一个节目，为什么你还要要求一个节目呢！

tamariz 发表于 2022-7-5 18:03:56

这只是一个视频编辑，我在填充（手动）字段的地方剪切序列
这是为了更好地理解我的要求（我的英语很差）

tamariz 发表于 2022-7-5 18:06:15

还有一个问题：
如何修改lisp以用简单文本替换字段？
我正在写一个lisp，有两个选项（字段和文本）

hmsilva 发表于 2022-7-5 18:09:00

也许是这样的
亨里克

页: [1] 2

乐筑天下's Archiver

将多段线长度提取到