修改代码以拉动提示

Dude_Guy · 发表于 2022-7-5 16:15:23

你好

我想知道是否有可能修改此代码以获取提示，而不是标记名？它适用于其他两个文件，如果需要，我可以附加它们。

(defun TE3 (ent / DCLID entg cnt CNT2 chk lisn lism lisd goval entf entn)
; (setq        olderr        *error*
;        *error*        TE3ERR
;  )
 (COMMAND "_.UNDO" "_GROUP")
;  (SETQ ENT (CAR (ENTSEL)))
 (setq entf ent)
 (setq        chk  nil
cnt  0
lisn '()
lism '()
lisd '()
 )
 (while (and (/= ent nil) (= chk nil))
   (setq entg (entget ent))
   (if        (= (strcase (cdr (assoc 0 entg))) "ATTRIB")
     (PROGN
(setq cnt (1+ cnt))
(SETQ LISN (CONS CNT LISN))
(SETQ LISM (CONS (CDR (ASSOC 1 entg)) lism))
(SETQ LISD (CONS (CDR (ASSOC 2 entg)) lisd))        
     )
   )
   (if        (/= (assoc -2 entg) nil)
     (setq chk 1)
   )
   (setq ent (entnext ent))
 )
 (if (and (> cnt 0) (< cnt 18)) ;ADDED A 17TH LINE AET 5/18/15
   (progn
     (setq lisn (reverse lisn))
     (setq lism (reverse lism))
     (setq lisd (reverse lisd))      
     (SETQ DCLID (LOAD_DIALOG "TE3"))
     (if (not (new_dialog "TE3" dclid))
(exit)
     )
     (ACTION_TILE
"edit_1"
"(SETQ edit_1 $VALUE)(MODT "edit_2")"
     )
     (ACTION_TILE
"edit_2"
"(SETQ edit_2 $VALUE)(MODT "edit_3")"
     )
     (ACTION_TILE
"edit_3"
"(SETQ edit_3 $VALUE)(MODT "edit_4")"
     )
     (ACTION_TILE
"edit_4"
"(SETQ edit_4 $VALUE)(MODT "edit_5")"
     )
     (ACTION_TILE
"edit_5"
"(SETQ edit_5 $VALUE)(MODT "edit_6")"
     )
     (ACTION_TILE
"edit_6"
"(SETQ edit_6 $VALUE)(MODT "edit_7")"
     )
     (ACTION_TILE
"edit_7"
"(SETQ edit_7 $VALUE)(MODT "edit_8")"
     )
     (ACTION_TILE
"edit_8"
"(SETQ edit_8 $VALUE)(MODT "edit_9")"
     )
     (ACTION_TILE
"edit_9"
"(SETQ edit_9 $VALUE)(MODT "edit_10")"
     )
     (ACTION_TILE
"edit_10"
"(SETQ edit_10 $VALUE)(MODT "edit_11")"
     )
     (ACTION_TILE
"edit_11"
"(SETQ edit_11 $VALUE)(MODT "edit_12")"
     )
     (ACTION_TILE
"edit_12"
"(SETQ edit_12 $VALUE)(MODT "edit_13")"
     )
     (ACTION_TILE
"edit_13"
"(SETQ edit_13 $VALUE)(MODT "edit_14")"
     )
     (ACTION_TILE
"edit_14"
"(SETQ edit_14 $VALUE)(MODT "edit_15")"
     )
     (ACTION_TILE
"edit_15"
"(SETQ edit_15 $VALUE)(MODT "edit_16")"
     )
     (ACTION_TILE
"edit_16"
"(SETQ edit_16 $VALUE)(MODT "edit_17")" ;ADDED A 17TH LINE AET 5/18/15
     )
     (ACTION_TILE "edit_17" "(SETQ edit_16 $VALUE)(MODT "OK")")
     (ACTION_TILE "OK" "(setq lism (get_vals cnt))(setq goval 1)(DONE_DIALOG)")
     (ACTION_TILE "CANCEL" "(DONE_DIALOG)")
     (SETQ CNT2 0)
     (WHILE (/= (NTH CNT2 LISM) NIL)
(SET_TILE (STRCAT "edit_" (ITOA (NTH CNT2 LISN))) (nth CNT2 lism))
(SET_TILE (STRCAT "prompt_" (ITOA (NTH CNT2 LISN))) (nth CNT2 lisd))        
(SETQ CNT2 (1+ CNT2))
     )
     (SETQ CNT2 (+ 1 CNT))
     (WHILE (<= CNT2 17)
       (MODE_TILE (STRCAT "edit_" (ITOA CNT2)) 1)
(SETQ CNT2 (1+ CNT2))
     )
     (MODE_TILE "edit_1" 2)
     (start_dialog)
     ;***main part
     (if (= goval 1)
      (progn
(setq cnt2 0 entn entf chk nil)
             (while (and (/= entn nil) (= chk nil) (< CNT2 CNT))
        (setq entg (entget entn))          
        (if (= (strcase (cdr (assoc 0 entg))) "ATTRIB")
         (PROGN
           (SETQ ENTG (SUBST (CONS 1 (nth cnt2 lism)) (ASSOC 1 entg) entg))
    (setq cnt2 (1+ cnt2))
    (ENTMOD ENTG)(ENTUPD ENTF)
  )  
        )
        (if (/= (assoc -2 entg) nil)
          (setq chk 1)
        )
        (setq entn (entnext entn))
       )
      )
     )        
   )
 )
;  (setq *error* olderr)                        ; Restore old *error* handler
 (command "_.UNDO" "_end")
 (prin1)
)
(DEFUN MODT (TG)
 (IF (= $REASON 1)
   (MODE_TILE TG 2)
 )
)
(defun get_vals (cnt / cnt2 lism)
 (setq lism '() cnt2 0)
 (while (< cnt2 cnt)
   (SETQ LISM (CONS (GET_TILE (STRCAT "edit_" (ITOA (NTH CNT2 LISN)))) lism))
   (SETQ cnt2 (1+ cnt2))
 )
 (setq lism (reverse lism))
 lism
)

Tharwat · 发表于 2022-7-5 16:28:06

对不起，我对LISP有点陌生，这些程序是我公司的一位工程师很久以前写的（他已经不在了）。我是否可以将该代码放在lisp文件的顶部，然后使用assoc 3提取提示？

Dude_Guy · 发表于 2022-7-5 16:34:39

如何选择属性块？因为我看到你评论了要求用户选择对象的代码。

Tharwat · 发表于 2022-7-5 16:49:31

copy


(defun promptstring (blockname tagstring / obj ent lst)
 ;; Tharwat - Date: 26.Jun.2017        ;;
 (if (and (tblsearch "BLOCK" blockname)
          (setq obj (tblobjname "BLOCK" blockname))
       )
     (while (setq obj (entnext obj))
       (and (= (cdr (assoc 0 (setq ent (entget obj)))) "ATTDEF")
            (= (cdr (assoc 2 ent)) tagstring)
            (setq lst (cons (cdr (assoc 3 ent)) lst))
       )
     )
   )
 lst
)

Dude_Guy · 发表于 2022-7-5 16:51:40

不管你张贴的所有代码，所以在这里我试图帮助你完成一项具体任务。

只需忽略我上面发布的函数，并考虑以下内容，只需将其添加到TE3函数的顶部；

copy

;TE.LSP VER2008.1
;Universal text editor (text, mtext, dimensions, leader text, title blocks, tags, etc..)
(defun TEERR (s)
 (if (/= s "Function cancelled")     ; If an error (such as CTRL-C) occurs
   (princ (strcat "\nError: " s))    ; while this command is active...
 ) 
 (setvar "attdia" attd)
 (command "_.UNDO" "_end") 
 (setq *error* olderr)               ; Restore old *error* handler
 (princ)                             
) 
(DEFUN C:te (/ z1 z2 lis ENT CLA FRAC ENTl entg cmde bnm
               NNT1 NNT2 DOD ATTD) 
(setq olderr *error* 
       *error* TEERR)
(COMMAND "_.UNDO" "_GROUP")
(SETQ ATTD (GETVAR "ATTDIA"))
(SETVAR "ATTDIA" 0)
(SETQ CHKSTAT 1)
(WHILE (NOT ENT)
 (SETQ ENT (CAR (ENTSEL)))
)
(IF (= (CDR (ASSOC 0 (ENTGET ENT))) "DIMENSION")
 (PROGN
  (SETQ NNT (SERD ENT))
  (SETQ NNT (FILT NNT))
  (DEFTIL)
  (IF (= CHKSTAT 1) (COMMAND "DIM1" "NEWTEXT" NNT ENT ""))
 )
)
(IF (= (CDR (ASSOC 0 (ENTGET ENT))) "TEXT")
 (PROGN
  (SETQ NNT (CDR (ASSOC 1 (ENTGET ENT))))
  (DEFTIL)
  (IF (= CHKSTAT 1)
   (PROGN
    (SETQ ENTG (ENTGET ENT))
    (SETQ entg (SUBST (CONS 1 nnt) (ASSOC 1 entg) entg))
    (entmod entg)
   )
  )
 )
)
(IF (= (CDR (ASSOC 0 (ENTGET ENT))) "MTEXT")
 (progn
  (COMMAND "_ddedit" ent)
  (command "")
 )
)
(IF (and (= (CDR (ASSOC 0 (ENTGET ENT))) "INSERT")
         (/= (CDR (ASSOC 2 (ENTGET ENT))) "DTAG")
         (/= (CDR (ASSOC 2 (ENTGET ENT))) "DTAG2"))
 (progn
  (load "te3")
  (te3 ent)
 )
)  
(IF (and (= (CDR (ASSOC 0 (ENTGET ENT))) "INSERT")
         (OR (= (CDR (ASSOC 2 (ENTGET ENT))) "DTAG")
             (= (CDR (ASSOC 2 (ENTGET ENT))) "DTAG2")))
 (PROGN
  (SETQ DOD 1)
  (SETQ Z1 (ENTGET (ENTNEXT ENT)))
  (SETQ Z2 (ENTGET (ENTNEXT (ENTNEXT ENT))))
  (SETQ NNT1 (CDR (ASSOC 1 Z1))) 
  (SETQ NNT2 (CDR (ASSOC 1 Z2))) 
  (DEFTIL2)
  (SETQ NNT2 (FTAG NNT2))
  (IF (= DOD 1)
   (PROGN
    (SETQ Z1 (ENTGET (ENTNEXT ENT)))
    (SETQ Z2 (ENTGET (ENTNEXT (ENTNEXT ENT))))
    (SETQ Z1 (SUBST (CONS 1 nnt1) (ASSOC 1 Z1) Z1))
    (SETQ Z2 (SUBST (CONS 1 nnt2) (ASSOC 1 Z2) Z2))
    (ENTMOD Z1)(ENTMOD Z2)
    (SETQ Z2 (SUBST (CONS 41 0.75) (ASSOC 41 Z2) Z2))
    (ENTMOD Z2)
    (IF (> (STRLEN NNT2) 0)  ;LINES FOR WIDTH FACTOR REDUCTION OF BOTTOM TEXT
     (IF (> (STRLEN NNT2) 6)
      (PROGN
       (SETQ Z2 (SUBST (CONS 41 (* (/ 6.0 (STRLEN NNT2)) 0.75)) (ASSOC 41 Z2) Z2))
       (ENTMOD Z2)
      )
     ) 
    )
    (ENTUPD ENT)
   )
  ) 
 )
)
(SETQ ENT NIL NNT NIL NNT1 NIL NNT2 NIL)
(setvar "attdia" attd)
(command "_.undo" "_end")
(setq *error* olderr)               ; Restore old *error* handler
(prin1)
)
(defun deftil (/ DCL_ID)
(IF (< (SETQ DCL_ID (LOAD_DIALOG "TE.DCL")) 0) (EXIT))
(NEW_DIALOG "TE" DCL_ID)
(set_tile "TXT" nnt) (SETQ NNTOLD NNT)
; (action_tile "TXT" "(setq nnt $value)(MODT "OK")")
; (action_tile "OK" "(done_dialog)")  
(action_tile "CANCEL" "(SETQ CHKSTAT NIL)(setq nnt NIL)(done_dialog)")
(action_tile "TXT" "(setq nnt $value)")
(start_dialog)
(DONE_DIALOG)
)
(DEFUN MODT (TG)
(IF (= $REASON 1)
 (MODE_TILE TG 2)
)
)
(defun deftil2 (/ DCL_ID)
(IF (< (SETQ DCL_ID (LOAD_DIALOG "TE2.DCL")) 0) (EXIT))
(NEW_DIALOG "TE2" DCL_ID)
(set_tile "TXT1" nnt1)
(set_tile "TXT2" nnt2)
(action_tile "TXT1" "(setq nnt1 $value)(MODT "TXT2")")
(action_tile "TXT2" "(setq nnt2 $value)(MODT "DONE")")
(action_tile "DONE" "(done_dialog)")
(action_tile "CANCEL" "(SETQ DOD NIL)(done_dialog)")
(MODE_TILE "TXT1" 2)
(start_dialog)
(DONE_DIALOG)
)
;; SERD >DIMENSION   >returns nested text string(s) IN DIMENSION
(DEFUN SERD (ENT / BOOL ENTL ENTG ENT2 ENTG2 DEF DEF2 TB)
(SETQ BOOL "T" ENTL ENT ENTG NIL DEF "" DEF2 "" ENT2 NIL ENTG2 NIL tb nil)
(IF (= (CDR (ASSOC 0 (ENTGET ENT))) "DIMENSION")
 (PROGN
  (SETQ TB (TBLSEARCH "BLOCK" (CDR (ASSOC 2 (ENTGET ENT)))))
  (SETQ ENTL (CDR (ASSOC -2 TB)))
  (WHILE (= BOOL "T")
   (SETQ ENTG (ENTGET ENTL))
;    (IF (AND (= (CDR (ASSOC 0 ENTG)) "TEXT")
;             (/= (CDR (ASSOC 1 ENTG)) "")
;        ) 
   (IF (OR (AND (= (CDR (ASSOC 0 ENTG)) "TEXT")
            (/= (CDR (ASSOC 1 ENTG)) "")
           ) 
           (AND (= (CDR (ASSOC 0 ENTG)) "MTEXT")
            (/= (CDR (ASSOC 1 ENTG)) "")
           ) 
        )
    (PROGN
     (SETQ BOOL NIL)
     (SETQ DEF (CDR (ASSOC 1 ENTG)))
;      (IF (= (CDR (ASSOC 0 (ENTGET (ENTNEXT ENTL)))) "TEXT")
     (IF (OR (= (CDR (ASSOC 0 (ENTGET (ENTNEXT ENTL)))) "TEXT") (= (CDR (ASSOC 0 (ENTGET (ENTNEXT ENTL)))) "MTEXT"))
      (PROGN
       (SETQ ENT2 (ENTNEXT ENTL))
       (SETQ ENTG2 (ENTGET ENT2))
       (IF (OR (= (CDR (ASSOC 0 ENTG2)) "TEXT") (= (CDR (ASSOC 0 ENTG2)) "MTEXT"))
        (SETQ DEF2 (CDR (ASSOC 1 ENTG2)))
       )
      )
     )
    )
    (PROGN
     (SETQ ENTL (ENTNEXT ENTL))
     (SETQ ENTG NIL)
    )
   )
  )
 )
 (SETQ DEF (CDR (ASSOC 1 (ENTGET ENT))) DEF2 "")
)
(STRCAT DEF2 DEF)
) 
(DEFUN FTAG (STRNG / CHK NSTRNG SIG) 
(SETQ NSTRNG STRNG SIG """)
(IF (> (STRLEN STRNG) 0)
 (SETQ CHK (SUBSTR STRNG (STRLEN STRNG) 1))
 (SETQ CHK """)
)
(IF (/= CHK """) 
 (PROGN
  (IF (= STRNG "") (SETQ SIG ""))
  (IF (> (STRLEN STRNG) 2)
   (PROGN
    (IF (OR (= (SUBSTR STRNG (1- (STRLEN STRNG))) "mm")
            (= (SUBSTR STRNG (- (STRLEN STRNG) 2)) "npt"))
     (SETQ NSTRNG STRNG)
     (SETQ NSTRNG (STRCAT STRNG SIG))
    ) 
   ) 
   (IF (OR (= STRNG "-") (= STRNG ""))
    (SETQ NSTRNG STRNG)
    (SETQ NSTRNG (STRCAT STRNG SIG))
   )
  ) 
 )
)
NSTRNG
)
(DEFUN FILT (NNT / SLEN TXT CNT)
(SETQ SLEN (STRLEN NNT))
(SETQ TXT "")
(IF (> SLEN 1)
 (PROGN
  (SETQ CNT SLEN)
  (WHILE (> CNT 0)
   (IF (= (SUBSTR NNT CNT 1) ";")
    (PROGN
     (SETQ TXT (SUBSTR NNT (1+ CNT) (- SLEN CNT)))
     (SETQ CNT 0)
    )
    (SETQ CNT (1- CNT))
   )
  )
 )
)
TXT
)

在函数TE3中，只需替换这个；

copy

(defun promptstring (blockname / obj ent lst)
 ;; Tharwat - Date: 26.Jun.2017        ;;
 (if (and (tblsearch "BLOCK" blockname)
          (setq obj (tblobjname "BLOCK" blockname))
       )
     (while (setq obj (entnext obj))
       (and (= (cdr (assoc 0 (setq ent (entget obj)))) "ATTDEF")
            (setq lst (cons (cdr (assoc 3 ent)) lst))
       )
     )
   )
 (if lst (car lst))
)

有了这个；

copy

(SETQ LISD (CONS (CDR (ASSOC 2 entg)) lisd))

注意：属性块必须是常规块，而不是动态块，否则需要使用vla get effectivename函数获取块的名称。

Tharwat · 发表于 2022-7-5 17:06:31

我已经这样做了，autocad在尝试加载编辑器时崩溃了？

登录/注册后可看大图

我不认为有什么我可以搞砸的，我不认为这个街区是动态的？我不应该编辑。DCL对吗？

[code]；增加了第17行AET 5/18/15；编辑为拉动提示而不是标签AET 6/26/17；由TE使用。LSP用于编辑具有属性的块；拉提示的程序：（defun promptstring（blockname/obj ent lst）；；塔尔瓦特-日期：26。2017年6月；；（if（and（tblsearch“BLOCK”blockname）（setq obj（tblobjname“BLOCK”blockname））（while（setq obj（entnext obj））（and（（cdr（assoc 0（setq ent（entget obj））））“ATTDEF”）（setq lst（cons（cdr（assoc 3 ent））lst）（if lst（car lst））（defun TE3（ent/DCLID entg cnt cnt 2 chk lisn lism lisd goval entf entn）；（setq olderr*error*；*error*TE3ERR；）（命令“_.UNDO”“_GROUP”）；（SETQ ENT（CAR（ENTSEL））（SETQ entf ENT）（SETQ chk nilcnt 0lisn'（）lism'（）lisd'（））（while（and（/=ENT nil）（=chk nil））（SETQ entg（entget ENT））（if（=（strcase（cdr（assoc 0 entg））“ATTRIB”）（PROGN（SETQ cnt（1+cnt））（SETQ LISN（CONS cnt LISN））（SETQ lism（CONS（cdr（assoc 1 entg））lism））（SETQ lisd（CONS（promptstring（cdr（1））。assoc 2（entget ENT）））lisd）；使用上述fcn获取提示；（SETQ LISD（CONS（CDR（ASSOC 2 entg））LISD））（if（/=（ASSOC-2 entg）nil）（SETQ chk 1））（SETQ ent（entnext ent））（if（和（>cnt 0）（<cnt 18））；增加了第17行AET 5/18/15（progn（setq lisn（reverse lisn））（setq lism（reverse lism））（setq lisd（reverse lisd））（setq DCLID（LOAD\u DIALOG“TE3”）（if（not（new\u DIALOG“TE3”DCLID））（exit））（ACTION\u TILE“edit\u 1”“（setq edit\u 1$VALUE）（MODT“edit\u 2”）（ACTION\u TILE“edit\u 2”“（setq edit\u 2$VALUE）（MODT“edit\u 3”）（ACTION\u TILE“edit\u 3“（SETQ edit_3$VALUE）（MODT“edit_4”）（ACTION_TILE“edit_4”（SETQ edit_4$VALUE）（MODT“edit_5”）（ACTION_TILE“edit_5”（SETQ edit_5$VALUE）（MODT“edit_6”）（ACTION_TILE“edit_6”“（SETQ edit_6$VALUE）（MODT“edit_7”）（ACTION_TILE“edit_7”“（SETQ edit_7$VALUE）（MODT“edit_8”）（ACTION\u TILE“edit\u 8”“（SETQ edit\u 8$VALUE）（MODT“edit\u 9”）（ACTION\u TILE“edit\u 9”“（SETQ edit\u 9$VALUE）（MODT“edit\u 10”）（ACTION\u TILE“edit\u 10”“（SETQ edit\u 10$VALUE）（MODT“edit\u 11”）（ACTION\u TILE“edit\u 11”“（SETQ edit\u 11$VALUE）（MODT“edit\u 12”“（SETQ edit\u 12$VALUE）（MODT“edit\u 13”）（ACTION\u TILE“edit\u 13”“（SETQ edit\u 13$VALUE）（MODT MODT“edit\u 14”）（ACTION\u TILE“edit\u 14”（SETQ edit\u 14$VALUE）（MODT“edit\u 15”）（ACTION\u TILE“edit\u 15”“（SETQ edit\u 15$VALUE）（MODT“edit\u 16”）（ACTION\u TILE“edit\u 16”“（SETQ edit\u 16$VALUE）（MODT“edit\u 17”）；添加了第17行AET 5/18/15）（ACTION\u TILE“edit\u 17”“（SETQ edit\u 16$VALUE）（MODT“OK”）（ACTION\u TILE“OK”“（SETQ lism（get\u vals cnt））（SETQ goval 1）（DONE\u对话框）“（操作”TILE“取消”（完成对话框）“）（SETQ CNT2 0）（WHILE（/=（NTH CNT2 LISM）NIL）（SET_平铺（STRCAT“edit_”（ITOA（NTH CNT2 LISN）））（NTH CNT2 LISM））（SET_平铺（STRCAT“prompt_）（ITOA（NTH CNT2 LISN））（NTH CNT2 lisd））（SETQ CNT2（1+CNT2）））（SETQ CNT2（+1 CNT））（WHILE（

Dude_Guy · 发表于 2022-7-5 17:14:12

抱歉，图像链接已断开：

Dude_Guy · 发表于 2022-7-5 17:22:07

[编程交流] 修改代码以拉动提示

发表回复

精选推荐