社区 › Auto Lisp › 修改代码以拉动提示

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        chknil
cnt0
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

(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函数的顶部；
;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中，只需替换这个；
(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))
)
有了这个；
(SETQ LISD (CONS (CDR (ASSOC 2 entg)) lisd))
 
注意：属性块必须是常规块，而不是动态块，否则需要使用vla get effectivename函数获取块的名称。

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

我已经这样做了，autocad在尝试加载编辑器时崩溃了？
 
https://gyazo.com/938183deaf682ec63add360c1b8ee02e
 
我不认为有什么我可以搞砸的，我不认为这个街区是动态的？我不应该编辑。DCL对吗？
 
；增加了第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

查看完整版本: 修改代码以拉动提示