设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › [注意]怎样实现这个？
123456下一页
返回列表 发新帖
楼主: tukuitk

[注意]怎样实现这个？

  [复制链接]
tukuitk
 楼主| 发表于 2003-11-1 10:26:00 | 显示全部楼层
对，我咋没想到避嫌呢，等龙兄上来了我再发上来，免得龙兄……，呵呵呵
回复 支持 反对

使用道具 举报

龙龙仔
发表于 2003-11-3 08:13:00 | 显示全部楼层
程序?
回复 支持 反对

使用道具 举报

tukuitk
 楼主| 发表于 2003-11-3 12:20:00 | 显示全部楼层
本帖最后由 作者 于 2003-11-3 13:53:57 编辑

龙兄：
你终于上来了！昨天我们放假了，没上网。现在我把程序放上来，你瞧瞧，还是给我加点积分讪！是你答应了的哟 ：）
请你和飞哥都把你们的实现这个功能的程序放上来，让我们拜读一下，好吗？
  2. (defun creatTextList (/ ss i ent)
  3.   (princ "\n请选择单行文字或多行文字:")
  4.   (setq ss (ssget '((0 . "*TEXT"))))
  5.   (setq i 0)
  6.   (repeat (SSLENGTH ss)
  7.     (setq ent (ssname ss i))
  8.     (setq
  9.       TextList (append TextList (list (cdr (assoc 1 (entget ent)))))
  10.     )
  11.     (setq i (+ i 1))
  12.   )
  13. )
  14. ;;;Fill
  15. (defun Fill (entBlock Text tag / i okEnt subEnt)
  16.   (setq i 0)
  17.   (setq subEnt (entnext entBlock))
  18.   (while subEnt
  19.     (if        (= (cdr (assoc 0 (entget subEnt))) "ATTRIB")
  20.       (progn
  21.         (if (= (cdr (assoc 2 (entget subEnt))) tag)
  22.           (progn
  23.             (setq
  24.               okEnt (subst (cons 1 Text)
  25.                            (assoc 1 (entget subEnt))
  26.                            (entget subEnt)
  27.                     )
  28.             )
  29.             (entmod okEnt)
  30.             (entupd entBlock)
  31.           )
  32.         )
  33.       )
  34.     )
  35.     (setq subEnt (entnext subEnt))
  36.   )
  37.   (princ)
  38. )
  39. ;;;end defun
  40. (Defun getList (entBlock dxf / slist Blockname AttEnt)
  41.   (setq slist (entget entBlock))
  42.   (SetQ        Blockname (Cdr (Assoc 2 slist))
  43.         slist          (TblSearch "BLOCK" Blockname)
  44.   )
  45.   (SetQ AttEnt (Cdr (Assoc -2 slist)))
  46.   (While AttEnt
  47.     (setq slist (entget AttEnt))
  48.     (if        (/= (cdr (assoc dxf slist)) nil)
  49.       (setq ReList (append ReList (list (cdr (assoc dxf slist)))))
  50.     )
  51.     (setq AttEnt (EntNext AttEnt))
  52.   )
  53.   (princ)
  54. )
  55. ;;;end defun

  57. (defun c:AttFill (/            ssBlock   j                jj          Block0
  58.                   u            entBlockList        TagList          ShowList
  59.                   v            TextList  ok        input          AttRefList
  60.                   ReList
  61.                  )
  62.   (setvar "CMDECHO" 0)
  63.   (command "undo" "begin")
  64.   (creatTextList)
  65.   (princ "\n请选择属性参照:")
  66.   (setq ssBlock (ssget '((0 . "INSERT"))))
  67.   (setq j 0)
  68.   (while (< j (sslength ssBlock))
  69.     (setq Block0 (ssname ssBlock j))
  70.     (setq entBlockList (append entBlockList (list Block0)))
  71.     (setq j (1+ j))
  72.   )
  73.   (setq jj 0)
  74.   (setq input 0)
  75.   (while (< jj (length entBlockList))
  76.     (getList (nth jj entBlockList) 2)
  77.     (setq TagList ReList)
  78.     (setq v 0
  79.           ShowList ""
  80.     )
  81.     (princ
  82.       (strcat "\n 所选的第" (itoa (+ 1 jj v)) "文字将填到: \n")
  83.     )
  84.     (repeat (length TagList)
  85.       (setq ShowList
  86.              (strcat ShowList
  87.                      (strcat (itoa v) "-" (nth v TagList) "  ")
  88.              )
  89.       )
  90.       (setq v (1+ v))
  91.     )
  92.     (setq ok (getint (strcat ShowList "   <" (itoa input) ">   ")))
  93.     (if        (= ok nil)
  94.       (setq ok input)
  95.       (setq input ok)
  96.     )
  97.     (if        (<= ok v)
  98.       (fill (nth jj entBlockList)
  99.             (nth jj TextList)
  100.             (nth ok TagList)
  101.       )
  102.       (exit)
  103.     )
  104.     (setq TagList nil
  105.           ReList nil
  106.           AttRefList
  107.            nil
  108.     )
  109.     (setq jj (1+ jj))
  110.   )
  111.   (command "undo" "end")
  112.   (princ)
  113. )
回复 支持 反对

使用道具 举报

龙龙仔
发表于 2003-11-3 15:45:00 | 显示全部楼层
本帖最后由 作者 于 2003-11-3 16:43:04 编辑

缺点:
1.        会修改相同提示属性
2.        有累积修改图块属性(即修改属性会连同上一个图块同时修改如下圖:)


先把以上修正好吗?



等修好我会再放上源代码!

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

tukuitk
 楼主| 发表于 2003-11-3 15:51:00 | 显示全部楼层
龙兄，我可不知道你的程序是不是for R14的哟。
你说的情况我怎么没发生？文字和块我是一个一个选择的。
回复 支持 反对

使用道具 举报

龙龙仔
发表于 2003-11-3 16:02:00 | 显示全部楼层
Sorry!圖是繁體的,希望你能用來測試!



我的程序是R14的,我可把它編譯為arx檔,只是檔案太大花不來,源代碼明天貼上(最後期限-要延期嗎?)

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

龙龙仔
发表于 2003-11-3 16:07:00 | 显示全部楼层
注意:這程序!
會修改相同提示屬性

;;;Fill
(defun Fill (entBlock Text tag / i okEnt subEnt)
  (setq i 0)
  (setq subEnt (entnext entBlock))
  (while subEnt
    (if (= (cdr (assoc 0 (entget subEnt))) "ATTRIB")
      (progn
(if (= (cdr (assoc 2 (entget subEnt))) tag)
   (progn
     (setq
       okEnt (subst (cons 1 Text)
      (assoc 1 (entget subEnt))
      (entget subEnt)
      )
     )
     (entmod okEnt)
     (entupd entBlock)
   )
)
      )
    )
    (setq subEnt (entnext subEnt))
  )
  (princ)
)
回复 支持 反对

使用道具 举报

tukuitk
 楼主| 发表于 2003-11-3 16:13:00 | 显示全部楼层
是的，我还没注意到呢！让我再改一下！
回复 支持 反对

使用道具 举报

tukuitk
 楼主| 发表于 2003-11-3 16:27:00 | 显示全部楼层
本帖最后由 作者 于 2003-11-3 16:53:38 编辑

改为如下：
  2. (defun creatTextList (/ ss i ent)
  3.   (princ "\n请选择单行文字或多行文字:")
  4.   (setq ss (ssget '((0 . "*TEXT"))))
  5.   (setq i 0)
  6.   (repeat (SSLENGTH ss)
  7.     (setq ent (ssname ss i))
  8.     (setq
  9.       TextList (append TextList (list (cdr (assoc 1 (entget ent)))))
  10.     )
  11.     (setq i (+ i 1))
  12.   )
  13. )
  14. ;;;Fill
  15. (defun Fill (entBlock Text tag / i okEnt subEnt)
  16.   (setq i 0)
  17.   (setq subEnt (entnext entBlock))
  18.   (setq tj t)
  19.   (while (and (/= NIL subEnt) tj)
  20.     (if        (= (cdr (assoc 0 (entget subEnt))) "ATTRIB")
  21.       (progn
  22.         (if (= (cdr (assoc 2 (entget subEnt))) tag)
  23.           (progn
  24.             (setq
  25.               okEnt (subst (cons 1 Text)
  26.                            (assoc 1 (entget subEnt))
  27.                            (entget subEnt)
  28.                     )
  29.             )
  30.             (entmod okEnt)
  31.             (entupd entBlock)
  32.             (setq tj nil)
  33.           )
  34.         )
  35.       )
  36.     )
  37.     (setq subEnt (entnext subEnt))
  38.   )
  39.   (princ)
  40. )
  41. ;;;end defun
  42. (Defun getList (entBlock dxf / slist Blockname AttEnt)
  43.   (setq slist (entget entBlock))
  44.   (SetQ        Blockname (Cdr (Assoc 2 slist))
  45.         slist          (TblSearch "BLOCK" Blockname)
  46.   )
  47.   (SetQ AttEnt (Cdr (Assoc -2 slist)))
  48.   (While AttEnt
  49.     (setq slist (entget AttEnt))
  50.     (if        (/= (cdr (assoc dxf slist)) nil)
  51.       (setq ReList (append ReList (list (cdr (assoc dxf slist)))))
  52.     )
  53.     (setq AttEnt (EntNext AttEnt))
  54.   )
  55.   (princ)
  56. )
  57. ;;;end defun

  59. (defun c:AttFill (/            ssBlock   j                jj          Block0
  60.                   u            entBlockList        TagList          ShowList
  61.                   v            TextList  ok        input          AttRefList
  62.                   ReList
  63.                  )
  64.   (setvar "CMDECHO" 0)
  65.   (command "undo" "begin")
  66.   (creatTextList)
  67.   (princ "\n请选择属性参照:")
  68.   (setq ssBlock (ssget '((0 . "INSERT"))))
  69.   (setq j 0)
  70.   (while (< j (sslength ssBlock))
  71.     (setq Block0 (ssname ssBlock j))
  72.     (setq entBlockList (append entBlockList (list Block0)))
  73.     (setq j (1+ j))
  74.   )
  75.   (setq jj 0)
  76.   (setq input 0)
  77.   (while (< jj (length entBlockList))
  78.     (getList (nth jj entBlockList) 2)
  79.     (setq TagList ReList)
  80.     (setq v 0
  81.           ShowList ""
  82.     )
  83.     (princ
  84.       (strcat "\n 所选的第" (itoa (+ 1 jj v)) "文字将填到: \n")
  85.     )
  86.     (repeat (length TagList)
  87.       (setq ShowList
  88.              (strcat ShowList
  89.                      (strcat (itoa v) "-" (nth v TagList) "  ")
  90.              )
  91.       )
  92.       (setq v (1+ v))
  93.     )
  94.     (setq ok (getint (strcat ShowList "   <" (itoa input) ">   ")))
  95.     (if        (= ok nil)
  96.       (setq ok input)
  97.       (setq input ok)
  98.     )
  99.     (if        (<= ok v)
  100.       (if (<= (+ jj 1) (length TextList))
  101.         (fill (nth jj entBlockList)
  102.               (nth jj TextList)
  103.               (nth ok TagList)
  104.         )
  105.         (setq jj (+ 1 (length entBlockList)))
  106.       )
  107.       (exit)
  108.     )
  109.     (setq TagList nil
  110.           ReList nil
  111.           AttRefList
  112.            nil
  113.     )
  114.     (setq jj (1+ jj))
  115.   )
  116.   (command "undo" "end")
  117.   (princ)
  118. )
回复 支持 反对

使用道具 举报

龙龙仔
发表于 2003-11-3 16:51:00 | 显示全部楼层
下列是圖塊屬性順序:你的程序只能填入第7項, 第9項無法填入
不要再想修改fill函數,從程序根本修改

所選的第1文字將填到:
0-零件號碼  1-A/0  2-頁次  3-材料規格  4-零件名稱  5-比例  6-繪圖者  7-12.12.12
8-設計者  9-12.12.12  10-參考備註     <0>   7

所選的第2文字將填到:
0-零件號碼  1-A/0  2-頁次  3-材料規格  4-零件名稱  5-比例  6-繪圖者  7-12.12.12
8-設計者  9-12.12.12  10-參考備註     <7>   9
回复 支持 反对

使用道具 举报

123456下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-27 05:33 , Processed in 0.163219 second(s), 19 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表