lisp批量选择文本然后设置一个距离阈值将符合条件的每一个、两个或多个文本生成一...

h2295 · 发表于 2024-4-29 00:06:03

本帖最后由 h2295 于 2024-4-30 09:07 编辑

lisp批量选择文本然后设置一个距离阈值将符合条件的每一个、两个或多个文本生成一个属性块怎么实现啊？
例如你选择了10个文本，其中有一组3个和一组2个之间的距离在阈值内，则这3个text和2个text分别成为一个属性块的3、2个属性，而其它的则单独成块。

h2295 · 发表于 2024-5-7 21:54:47

这是参考吧内其它网友的代码修改整合的，目前只实现根据距离阈值两两成块，没能实现不定数量成块，可能存在不足之处，现发布一下，有需要或有兴趣的可以完善完善

;;; 批量文本转属性定义 txtat Define the top-level function for the command "txtatt"
(defun listToSelectionSet (entityList / ss)
(setq ss (ssadd))
(foreach ent entityList
(ssadd ent ss)
)
ss
)
(defun txtatt4 (ss1 c1 layer-name / ent66)
(setq attlist '()) ; 创建一个空列表用于存储属性定义实体
(setq curTime (rtos (* (getvar "cdate") 1e8)))
(setq blkname curTime) ; Specify the block name where you want to insert the ATTDEF
(setq ss111 (listToSelectionSet ss1))
(if ss111
(progn
(princ ss111)
(setq ii 0)
(repeat (sslength ss111)
(setq ent66 (ssname ss111 ii))
(princ ent66)
(setq tnewdxfem (txt2att4 ent66 ii blkname layer-name))
(setq ii (1+ ii))
(if (/= tnewdxfem nil)
(setq attlist (cons tnewdxfem attlist)) ; 将属性定义实体添加到列表中
)
)
(ZG_MakeBlock attlist c1)
)
(if (setq ent (entsel "\nSelect text entity: "))
(txt2att4 (car ent) ii blkname layer-name)
(prompt "No entity was selected.")
)
)
(princ)
)
;;; Define the core function that converts a text entity to an attribute definition
(defun txt2att4 (ent2 id blkname layer-name / entdxf newdxf malst tem)
(setq entdxf (entget ent2)
newdxf '((0 . "ATTDEF"))
newdxf (append
newdxf
(list
(cons 1 (cdr (assoc 1 entdxf)))
(cons 2 (rtos id))
(cons 3 (cdr (assoc 1 entdxf)))
(cons 70 0)
(cons 8 layer-name)
)
)
malst (list 7 10 11 39 40 41 50 51 62 71 72 73)
)
(foreach mai malst
(setq tem (assoc mai entdxf))
(if (/= tem nil)
(setq newdxf (append newdxf (list tem)))
)
)
; (entdel ent)
(entmake newdxf)
; 可以使用(entlast)函数获取最后一次创建的实体的句柄，然后再使用ssget函数选中这个实体
(setq entd (entlast))
; (princ entd)
; (setq ssd (ssget "X" (list (cons 0 (cdr (assoc 0 (entget entd)))))))
(eval entd)
)
(defun emkblk (ss blkname pt / i)
(princ ss)
(entmake (list '(0 . "block") (cons 2 blkname) '(70 . 0) (cons 10 pt)))
; (entmake (cdr (entget ss)))
(entmake ss)
; (repeat (setq i (sslength ss))
; (entmake (cdr (entget (ssname ss (setq i (1- i))))))
; )
(entmake '((0 . "ENDBLK")))
(command "_.erase" ss "")
(entmake (list '(0 . "INSERT") (cons 2 blkname) (cons 10 pt)))
)
(defun random (site / date random) ;@site作为随机数位数，定义为1，2，3分别对应0-9，0-99，0-999
(setq date (* 100000000 (getvar "cdate"))) ;获取当前时间并去掉小数点赋值到@date
(setq remValue 1) ;赋值除数为1
(repeat site
(setq remValue (* 10 remValue))
) ;循环次数等于保留位数，如果三次则@remValue等于1000，两次100，一次10
(setq random (rem date remValue)) ;将@date保留最后若干位，赋值到@random
)
;快速创建块
;块名为当前时间(如"2012101620161699"),块基点为选择集中心点
;命令：ZG_MakeBlock
(defun ZG_MakeBlock (ss44 c2 / zg-GetSSBoundingbox blipmode_bak ss44 blkname ssbox1
basept inspt
)
;功能：返回选择集包围盒
;参数: ss--选择集
;返回值：选择集所有实体做为整体的包围盒
;(setq ssbox (zg-GetSSBoundingbox (setq ss (ssget))))
(defun zg-GetSSBoundingbox (ss2 / iii ssn ll rr box ptlist ssbox)
(if ss2
(progn
(setq iii -1)
(repeat (sslength ss2)
(setq ssn (ssname ss2 (setq iii (1+ iii))))
(vla-GetBoundingBox (vlax-ename->vla-object ssn) 'll 'rr) ;得到对象的包围盒
(setq box (list (vlax-safearray->list ll) (vlax-safearray->list rr)))
(setq ptlist (append box ptlist))
)
(setq ssbox (mapcar '(lambda (x) (apply 'mapcar (cons x ptlist)))
(list 'min 'max)
)
)
)
)
)
(vl-load-com)
; (setq ss (cadr (ssgetfirst)))
(setvar "cmdecho" 0)
(command "_undo" "be")
(princ "\n选择快速创建块的对象: ")
; (if (or ss (setq ss (ssget)))
(setq ss444 (listToSelectionSet ss44))
(if (or ss444)
(progn
(setq randomNum (random 3))
(setq blkname (rtos (* (getvar "cdate") 1e8)))
(setq blkname (strcat blkname (rtos c2)))
(setq ssbox1 (zg-GetSSBoundingbox ss444))
(setq basept (apply 'mapcar
(cons (function (lambda (a b) (/ (+ a b) 2))) ssbox1)
)
)
(command "block" blkname "non" basept ss444 "") ;创建块并删除创建块的对象
(setq inspt basept)
; 设置为0：粘贴时不提示“输入属性”
; 设置为1：粘贴时提示“输入属性”
(command "attreq" "0")
(command "_.insert" blkname "x" 1 "y" 1 "z" 1 "r" 0 "non" inspt "") ;插入块
(command "attreq" "1")
)
)
(command "_undo" "e")
(setvar "cmdecho" 1)
(princ)
)
(defun get-midpoint (ent22) ;返回对象外包框的中点坐标BY:Dea25
(vl-load-com)
(if (= (type ent22) 'ENAME)
(mapcar '*
'(0.5 0.5 0.5)
(apply '(lambda (x1 x2) (mapcar '+ x1 x2))
(acet-ent-geomextents ent22)
)
)
nil
)
)
(defun calculate-distance (midpoint1 midpoint2)
; 计算两个中点之间的距离
(distance midpoint1 midpoint2)
)
(defun process-distance (distance1)
; 处理距离，如果距离小于1返回距离值，否则返回nil
(if (< distance1 1.5)
distance1
nil
)
)
(defun create-sequence (length start step)
(setq sequence '())
(repeat length
(setq sequence (cons start sequence))
(setq start (+ start step))
)
(reverse sequence)
)
(defun permutations (numbers / result i j)
; (setq numbers '(1 2 3))
(setq result '())
(setq i (getvar 'cmdactive))
(repeat (length numbers)
(setq j (+ i 1))
(repeat (- (length numbers) (+ 1 i))
(setq result (cons (list (nth i numbers) (nth j numbers)) result))
; (setq result (list (nth i numbers) (nth j numbers)))
(princ result)
(setq j (+ j 1))
)
(setq i (+ i 1))
)
(princ "\nPermutations: ")
(foreach pair result
(princ (strcat "(" (itoa (car pair)) " " (itoa (cadr pair)) ") "))
; (princ (strcat "(" (itoa pair) " " (itoa pair) ") "))
)
(princ)
(reverse result)
)
; (princ "\nType PERMUTATIONS to run the command.")
(defun create-sequence1 ()
(setq sequence1 (create-sequence 3 1 1))
(setq result (permutations sequence1))
(princ "\nPermutations: ")
(foreach pair result
(princ (strcat "(" (itoa (car pair)) " " (itoa (cadr pair)) ") "))
; (princ (strcat "(" (itoa pair) " " (itoa pair) ") "))
)
(princ)
)
(defun delay-1s ()
(setq start-time (getvar 'DATE))
(setq end-time (+ start-time 1.0))
(while (<= (getvar 'DATE) end-time)
(command "_.redraw")
)
)
(defun c:get-selected-texts ()
; 获取用户选择的文本对象
; 获取用户选择的文本对象
; (setq ss (ssget '((0 . "TEXT"))))
(setq ss1 (ssget "_:L" '((0 . "TEXT,MTEXT"))))
; 循环计算选择集中两两对象之间的距离
(setq n (sslength ss1))
(setq start 0)
(setq step 1)
(princ n)
(setq tempi -1)
(setq tempj -1)
(setq i 0)
(while (< i n)
(setq j (+ i 1))
(while (< j n)
(if (and (/= tempi i) (/= tempj j))
(progn
(princ i)
(princ j)
(princ tempi)
(princ tempj)
(setq ent1 (ssname ss1 i))
(setq ent2 (ssname ss1 j))
(setq midpoint1 (get-midpoint ent1))
(setq midpoint2 (get-midpoint ent2))
(princ midpoint1)
(setq distance1 (distance midpoint1 midpoint2))
(setq result (process-distance distance1))
(if result
(progn
(setq layer-name "图块图层")
(command "-layer" "n" layer-name "")
(command "-layer" "m" layer-name "")
(setq attlist '())
(setq ssd1 (ssget "X" (list (cons 0 (cdr (assoc 0 (entget ent1)))))))
(setq ssd2 (ssget "X" (list (cons 0 (cdr (assoc 0 (entget ent2)))))))
(setq attlist (cons ent1 attlist))
(setq attlist (cons ent2 attlist))
(txtatt4 attlist i layer-name)
(princ
(strcat "Distance between object "
(itoa i)
" and object "
(itoa j)
": "
(rtos distance1)
"\n"
)
)
(setq tempi i)
(setq tempj j)
(princ
(strcat "Distance between object1 "
(itoa tempi)
" and object1 "
(itoa tempj)
": "
(rtos distance1)
"\n"
)
)
)
)
)
)
(setq j (+ j 1))
)
(setq i (+ i 1))
)
(princ "Calculation completed.")
)

;;; 批量文本转属性定义 txtat Define the top-level function for the command "txtatt" 
(defun listToSelectionSet (entityList / ss) 
  (setq ss (ssadd)) 
  (foreach ent entityList 
    (ssadd ent ss) 
  ) 
  ss 
) 
(defun txtatt4 (ss1 c1 layer-name / ent66) 
  (setq attlist '()) ; 创建一个空列表用于存储属性定义实体 
  (setq curTime (rtos (* (getvar "cdate") 1e8))) 
  (setq blkname curTime) ; Specify the block name where you want to insert the ATTDEF 
  (setq ss111 (listToSelectionSet ss1)) 
  (if ss111 
    (progn 
      (princ ss111) 
      (setq ii 0) 
      (repeat (sslength ss111) 
        (setq ent66 (ssname ss111 ii)) 
        (princ ent66) 
        (setq tnewdxfem (txt2att4 ent66 ii blkname layer-name)) 
        (setq ii (1+ ii)) 
        (if (/= tnewdxfem nil) 
          (setq attlist (cons tnewdxfem attlist)) ; 将属性定义实体添加到列表中 
        ) 
      ) 
      (ZG_MakeBlock attlist c1) 
    ) 
    (if (setq ent (entsel "\nSelect text entity: ")) 
      (txt2att4 (car ent) ii blkname layer-name) 
      (prompt "No entity was selected.") 
    ) 
  ) 
  (princ) 
) 
;;; Define the core function that converts a text entity to an attribute definition 
(defun txt2att4 (ent2 id blkname layer-name / entdxf newdxf malst tem) 
 
  (setq entdxf (entget ent2) 
        newdxf '((0 . "ATTDEF")) 
        newdxf (append 
                 newdxf 
                 (list 
                   (cons 1 (cdr (assoc 1 entdxf))) 
                   (cons 2 (rtos id)) 
                   (cons 3 (cdr (assoc 1 entdxf))) 
                   (cons 70 0) 
                   (cons 8 layer-name) 
                 ) 
               ) 
        malst  (list 7 10 11 39 40 41 50 51 62 71 72 73) 
  ) 
  (foreach mai malst 
    (setq tem (assoc mai entdxf)) 
    (if (/= tem nil) 
      (setq newdxf (append newdxf (list tem))) 
    ) 
  ) 
  ; (entdel ent) 
  (entmake newdxf) 
  ; 可以使用(entlast)函数获取最后一次创建的实体的句柄，然后再使用ssget函数选中这个实体 
  (setq entd (entlast)) 
  ; (princ entd) 
  ; (setq ssd (ssget "X" (list (cons 0 (cdr (assoc 0 (entget entd))))))) 
  (eval entd) 
) 
 
(defun emkblk (ss blkname pt / i) 
  (princ ss) 
  (entmake (list '(0 . "block") (cons 2 blkname) '(70 . 0) (cons 10 pt))) 
  ; (entmake (cdr (entget ss))) 
  (entmake ss) 
  ; (repeat (setq i (sslength ss)) 
  ;   (entmake (cdr (entget (ssname ss (setq i (1- i)))))) 
  ; ) 
  (entmake '((0 . "ENDBLK"))) 
  (command "_.erase" ss "") 
  (entmake (list '(0 . "INSERT") (cons 2 blkname) (cons 10 pt))) 
) 
(defun random (site / date random)  ;@site作为随机数位数，定义为1，2，3分别对应0-9，0-99，0-999 
 
  (setq date (* 100000000 (getvar "cdate"))) ;获取当前时间并去掉小数点赋值到@date 
  (setq remValue 1) ;赋值除数为1 
  (repeat site 
    (setq remValue (* 10 remValue)) 
  ) ;循环次数等于保留位数，如果三次则@remValue等于1000，两次100，一次10 
  (setq random (rem date remValue)) ;将@date保留最后若干位，赋值到@random 
) 
;快速创建块 
;块名为当前时间(如"2012101620161699"),块基点为选择集中心点 
;命令：ZG_MakeBlock 
(defun ZG_MakeBlock (ss44 c2 / zg-GetSSBoundingbox blipmode_bak ss44 blkname ssbox1 
                     basept inspt 
                    ) 
  ;功能：返回选择集包围盒 
  ;参数: ss--选择集 
  ;返回值：选择集所有实体做为整体的包围盒 
  ;(setq ssbox (zg-GetSSBoundingbox (setq ss (ssget)))) 
  (defun zg-GetSSBoundingbox (ss2 / iii ssn ll rr box ptlist ssbox) 
    (if ss2 
      (progn 
        (setq iii -1) 
        (repeat (sslength ss2) 
          (setq ssn (ssname ss2 (setq iii (1+ iii)))) 
          (vla-GetBoundingBox (vlax-ename->vla-object ssn) 'll 'rr) ;得到对象的包围盒 
          (setq box (list (vlax-safearray->list ll) (vlax-safearray->list rr))) 
          (setq ptlist (append box ptlist)) 
        ) 
        (setq ssbox (mapcar '(lambda (x) (apply 'mapcar (cons x ptlist))) 
                            (list 'min 'max) 
                    ) 
        ) 
      ) 
    ) 
  ) 
  (vl-load-com) 
  ; (setq ss (cadr (ssgetfirst))) 
  (setvar "cmdecho" 0) 
  (command "_undo" "be") 
  (princ "\n选择快速创建块的对象: ") 
  ; (if (or ss (setq ss (ssget))) 
  (setq ss444 (listToSelectionSet ss44)) 
  (if (or ss444) 
    (progn 
      (setq randomNum (random 3)) 
      (setq blkname (rtos (* (getvar "cdate") 1e8))) 
      (setq blkname (strcat blkname (rtos c2))) 
      (setq ssbox1 (zg-GetSSBoundingbox ss444)) 
      (setq basept (apply 'mapcar 
                          (cons (function (lambda (a b) (/ (+ a b) 2))) ssbox1) 
                   ) 
      ) 
      (command "block" blkname "non" basept ss444 "") ;创建块并删除创建块的对象 
      (setq inspt basept) 
      ; 设置为0：粘贴时不提示“输入属性” 
      ; 设置为1：粘贴时提示“输入属性” 
      (command "attreq" "0") 
      (command "_.insert" blkname "x" 1 "y" 1 "z" 1 "r" 0 "non" inspt "") ;插入块 
      (command "attreq" "1") 
    ) 
  ) 
  (command "_undo" "e") 
  (setvar "cmdecho" 1) 
  (princ) 
) 
 
 
(defun get-midpoint (ent22)  ;返回对象外包框的中点坐标BY:Dea25 
  (vl-load-com) 
  (if (= (type ent22) 'ENAME) 
    (mapcar '* 
            '(0.5 0.5 0.5) 
            (apply '(lambda (x1 x2) (mapcar '+ x1 x2)) 
                   (acet-ent-geomextents ent22) 
            ) 
    ) 
    nil 
  ) 
) 
 
 
(defun calculate-distance (midpoint1 midpoint2) 
  ; 计算两个中点之间的距离 
  (distance midpoint1 midpoint2) 
) 
 
(defun process-distance (distance1) 
  ; 处理距离，如果距离小于1返回距离值，否则返回nil 
  (if (< distance1 1.5) 
    distance1 
    nil 
  ) 
) 
 
 
(defun create-sequence (length start step) 
  (setq sequence '()) 
  (repeat length 
    (setq sequence (cons start sequence)) 
    (setq start (+ start step)) 
  ) 
  (reverse sequence) 
) 
 
(defun permutations (numbers / result i j) 
  ; (setq numbers '(1 2 3)) 
  (setq result '()) 
  (setq i (getvar 'cmdactive)) 
  (repeat (length numbers) 
 
    (setq j (+ i 1)) 
    (repeat (- (length numbers) (+ 1 i)) 
 
      (setq result (cons (list (nth i numbers) (nth j numbers)) result)) 
      ; (setq result (list (nth i numbers) (nth j numbers))) 
      (princ result) 
      (setq j (+ j 1)) 
    ) 
    (setq i (+ i 1)) 
  ) 
  (princ "\nPermutations: ") 
  (foreach pair result 
    (princ (strcat "(" (itoa (car pair)) " " (itoa (cadr pair)) ") ")) 
    ; (princ (strcat "(" (itoa pair) " " (itoa pair) ") ")) 
  ) 
  (princ) 
  (reverse result) 
) 
 
; (princ "\nType PERMUTATIONS to run the command.") 
 
(defun create-sequence1 () 
 
 
  (setq sequence1 (create-sequence 3 1 1)) 
  (setq result (permutations sequence1)) 
  (princ "\nPermutations: ") 
  (foreach pair result 
    (princ (strcat "(" (itoa (car pair)) " " (itoa (cadr pair)) ") ")) 
    ; (princ (strcat "(" (itoa pair) " " (itoa pair) ") ")) 
  ) 
  (princ) 
) 
 
(defun delay-1s () 
  (setq start-time (getvar 'DATE)) 
  (setq end-time (+ start-time 1.0)) 
  (while (<= (getvar 'DATE) end-time) 
    (command "_.redraw") 
  ) 
) 
(defun c:get-selected-texts () 
  ; 获取用户选择的文本对象 
 
 
  ; 获取用户选择的文本对象 
  ; (setq ss (ssget '((0 . "TEXT")))) 
  (setq ss1 (ssget "_:L" '((0 . "TEXT,MTEXT")))) 
  ; 循环计算选择集中两两对象之间的距离 
  (setq n (sslength ss1)) 
  (setq start 0) 
  (setq step 1) 
 
  (princ n) 
  (setq tempi -1) 
  (setq tempj -1) 
  (setq i 0) 
  (while (
    (setq j (+ i 1)) 
    (while (< j n) 
      (if (and (/= tempi i) (/= tempj j)) 
        (progn 
          (princ i) 
          (princ j) 
          (princ tempi) 
          (princ tempj) 
          (setq ent1 (ssname ss1 i)) 
          (setq ent2 (ssname ss1 j)) 
          (setq midpoint1 (get-midpoint ent1)) 
          (setq midpoint2 (get-midpoint ent2)) 
          (princ midpoint1) 
          (setq distance1 (distance midpoint1 midpoint2)) 
          (setq result (process-distance distance1)) 
          (if result 
            (progn 
              (setq layer-name "图块图层") 
              (command "-layer" "n" layer-name "") 
 
              (command "-layer" "m" layer-name "") 
              (setq attlist '()) 
              (setq ssd1 (ssget "X" (list (cons 0 (cdr (assoc 0 (entget ent1))))))) 
              (setq ssd2 (ssget "X" (list (cons 0 (cdr (assoc 0 (entget ent2))))))) 
              (setq attlist (cons ent1 attlist)) 
              (setq attlist (cons ent2 attlist)) 
              (txtatt4 attlist i layer-name) 
              (princ 
                (strcat "Distance between object " 
                        (itoa i) 
                        " and object " 
                        (itoa j) 
                        ": " 
                        (rtos distance1) 
                        "\n" 
                ) 
              ) 
              (setq tempi i) 
              (setq tempj j) 
              (princ 
                (strcat "Distance between object1 " 
                        (itoa tempi) 
                        " and object1 " 
                        (itoa tempj) 
                        ": " 
                        (rtos distance1) 
                        "\n" 
                ) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (setq j (+ j 1)) 
    ) 
    (setq i (+ i 1)) 
  ) 
 
  (princ "Calculation completed.") 
)

h2295 · 发表于 2024-5-7 22:01:59

你有种再说一遍发表于 2024-4-29 05:32
构建邻接表,不会就集合里面一一比较

大佬，我上传了一段代码只简单实现了两两成块，你看看能不能优化优化

你有种再说一遍 · 发表于 2024-4-29 05:32:47

本帖最后由你有种再说一遍于 2024-4-29 05:35 编辑

构建邻接表,不会就集合里面一一比较

guosheyang · 发表于 2024-4-29 07:45:49

感觉问题都没咋描述清楚

h2295 · 发表于 2024-4-30 09:08:31

guosheyang 发表于 2024-4-29 07:45
感觉问题都没咋描述清楚

例如你选择了10个文本，其中有一组3个和一组2个之间的距离在阈值内，则这3个text和2个text分别成为一个属性块的3、2个属性，而其它的则单独成块。

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

[讨论] lisp批量选择文本然后设置一个距离阈值将符合条件的每一个、两个或多个文本生成一...