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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › [求助]关于属性块中的属性对齐
返回列表 发新帖
查看: 1357|回复: 2

[求助]关于属性块中的属性对齐

[复制链接]
SWAYWOOD
发表于 2006-3-28 18:19 | 显示全部楼层 |阅读模式
请教大侠们，为什么我在选左边的“大块”的时候，运行后得出如下的提示，而选右边的“小块”的时候就没任何问题，下面的是DWG文件，请帮忙看看
  1. 请输入最下部文字栏线的左边点:
  2. 请输入最下部文字栏线的右边点:选择文字,或带属性的块...
  3. 选择对象: 找到 1 个
  4. 选择对象:
  5. 1
  6. 命令: 选择 2144 个，
  7. 是否确实要执行此操作? <N>
复制代码
  2. (defun c:sw_text_edit_3
  3.    (/     ent   ents  pt  ty    ss    i
  4.     pt2   sc    pt_lst  len   pt3   kdbl
  5.     p1    p2    align attpart     elist loop
  6.     p0    txb   width
  7.    )
  8.   ;(mkani)
  9.   ;(command "ucs" "w")
  10.   (setq p1 (getpoint "\n请输入最下部文字栏线的左边点:"))
  11.   (setq p2 (getpoint "\n请输入最下部文字栏线的右边点:"))
  12.   (prompt "选择文字,或带属性的块...")
  13.   (setq ss (ssget
  14.       '((-4 . "<OR") (0 . "TEXT") (0 . "INSERT") (-4 . "OR>"))
  15.     )
  16.   )
  17.   (setq sc 1)
  18.   (setq i 0)
  19.   (repeat (sslength ss)
  20.     (setq ent (ssname ss i))
  21.     (setq ents (entget ent))
  22.     (if (= (cdr (assoc 0 ents)) "TEXT")
  23.       (progn
  24. ;;以下处理TEXT
  25. (setq kdbl (cdr (assoc 41 ents)))
  26. (setq pt2 (cdr (assoc 10 ents)))
  27. (setq
  28.    pt2 (list (/ (+ (car p2) (car p1)) 2) (cadr pt2) (last pt2))
  29. )
  30. (setq pt_lst (textbox ents))
  31. (setq len (- (caadr pt_lst) (caar pt_lst)))
  32. (setq pt3 (polar pt2 (cdr (assoc 50 ents)) (* len sc)))
  33. (setq ents (subst (cons 11 pt2) (assoc 11 ents) ents))
  34. (setq ents (subst (cons 72 1) (assoc 72 ents) ents))
  35. (if (> len (abs (- (car p2) (car p1))))
  36.    (progn (setq kdbl
  37.    (* kdbl
  38.       (/ (- (abs (- (car p2) (car p1))) 1.2) (+ 2 len))
  39.    )
  40.    )
  41.    (setq ents (subst (cons 41 kdbl) (assoc 41 ents) ents))
  42.    )
  43. )
  44. (entmod ents)
  45. (setq i (1+ i))
  46.       )
  47.       (progn
  48. ;;以下处理INSERT中的属性文字
  49. (setq ent (entnext ent))
  50. ;;获取第一个属性图元
  51. (setq loop t
  52.        attpart nil
  53. )
  54. (while (and ent loop)
  55.    (setq elist (entget ent))
  56.    (if (= (cdr (assoc 0 elist)) "ATTRIB")
  57.      (progn
  58.        (setq align (cdr (assoc 72 elist)))
  59.        (cond
  60.   ((= align 0)
  61.    (setq p0 (cdr (assoc 10 elist)))
  62.    (setq txb (textbox elist))
  63.    (setq width (- (car (cadr txb)) (car (car txb))))
  64.    (setq p0 (list (+ (/ width 2.0) (car p0)) (cadr p0) 0))
  65.   )
  66.   ((= align 1)
  67.    (setq p0 (cdr (assoc 11 elist)))
  68.    (setq txb (textbox elist))
  69.    (setq width (- (car (cadr txb)) (car (car txb))))
  70.   )
  71.   ((= align 2)
  72.    (setq p0 (cdr (assoc 11 elist)))
  73.    (setq txb (textbox elist))
  74.    (setq width (- (car (cadr txb)) (car (car txb))))
  75.    (setq p0 (list (- (car p0) (/ width 2.0)) (cadr p0) 0))
  76.   )
  77.        )
  78.        (if (and (> (car p0) (car p1)) (< (car p0) (car p2)) (> WIDTH (ABS (- (CAR P1) (CAR P2)))))
  79.   (progn
  80.     (setq pt2 (cadr p0))
  81.     (setq
  82.       pt2 (list (/ (+ (car p2) (car p1)) 2.0)
  83.          pt2
  84.          0
  85.    )
  86.     )
  87.     (setq kdbl (cdr (assoc 41 elist)))
  88.     (setq pt_lst (textbox elist))
  89.     (setq len (- (caadr pt_lst) (caar pt_lst)))
  90.     (setq kdbl (* kdbl
  91.     (/ (- (abs (- (car p2) (car p1))) 1.2)
  92.        (+ 2 len)
  93.     )
  94.         )
  95.     )
  96.     (setq elist
  97.     (subst (cons 72 1) (assoc 72 elist) elist)
  98.     )
  99.     (setq elist
  100.     (subst (cons 11 pt2) (assoc 11 elist) elist)
  101.     )
  102.     (setq elist
  103.     (subst (cons 41 kdbl) (assoc 41 elist) elist)
  104.     )
  105.     (entmod elist)
  106.   )
  107.        )
  108.      )
  109.    )
  110.    (setq ent (entnext ent))
  111. )
  112. (entmod ents)
  113.       )
  114.     )
  115.     (SETQ I (+ I 1))
  116.   )
  117. )

本帖子中包含更多资源

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

x
"觉得好，就打赏"
打赏
还没有人打赏，支持一下
回复

使用道具 举报

SWAYWOOD
 楼主| 发表于 2006-3-29 09:43 | 显示全部楼层
顶一个，呵呵
回复 支持 反对

使用道具 举报

龙龙仔
发表于 2006-3-29 12:20 | 显示全部楼层
  3. 直接抓取移动属性看看
  4. ** 拉伸 **
  5. 指定拉伸点或 [基准点(B)/复制(C)/复原(U)/结束(X)]: 2144 已选取，
  6. 您确定要执行此操作吗? <N> *取消*
  7. 图块中物件多时,当修改属性时会出现这个提示
  9. 当然其实是程序没有写好
  10. (defun C:SW_TEXT_EDIT_3 (/ ALIGN1 ATTPART      ELIST  ENT
  11.     ENTS I      KDBL   LEN    P0     P1
  12.     P2 PT2    PT3    PT_LST SC     SS
  13.     TXB WIDTH
  14.    )
  15.   ;;(mkani)
  16.   ;;(command "ucs" "w")
  17.   (setq P1 (getpoint "\n请输入最下部文字栏线的左边点:"))
  18.   (setq P2 (getpoint "\n请输入最下部文字栏线的右边点:"))
  19.   (prompt "选择文字,或带属性的块...")
  20.   (setq SS (ssget
  21.       '((-4 . "<OR") (0 . "TEXT") (0 . "INSERT") (-4 . "OR>"))
  22.     )
  23.   )
  24.   (setq SC 1)
  25.   (setq I 0)
  26.   (repeat (sslength SS)
  27.     (setq ENT (ssname SS I))
  28.     (setq ENTS (entget ENT))
  29.     (if (= (cdr (assoc 0 ENTS)) "TEXT")
  30.       (progn
  31. ;;以下处理TEXT
  32. (setq KDBL (cdr (assoc 41 ENTS)))
  33. (setq PT2 (cdr (assoc 10 ENTS)))
  34. (setq
  35.    PT2 (list (/ (+ (car P2) (car P1)) 2) (cadr PT2) (last PT2))
  36. )
  37. (setq PT_LST (textbox ENTS))
  38. (setq LEN (- (caadr PT_LST) (caar PT_LST)))
  39. (setq PT3 (polar PT2 (cdr (assoc 50 ENTS)) (* LEN SC)))
  40. (setq ENTS (subst (cons 11 PT2) (assoc 11 ENTS) ENTS))
  41. (setq ENTS (subst (cons 72 1) (assoc 72 ENTS) ENTS))
  42. (if (> LEN (abs (- (car P2) (car P1))))
  43.    (progn (setq KDBL
  44.    (* KDBL
  45.       (/ (- (abs (- (car P2) (car P1))) 1.2) (+ 2 LEN))
  46.    )
  47.    )
  48.    (setq ENTS (subst (cons 41 KDBL) (assoc 41 ENTS) ENTS))
  49.    )
  50. )
  51. (entmod ENTS)
  52.       )
  53.       (progn
  54. ;;以下处理INSERT中的属性文字
  55. (setq ENT (entnext ENT))
  56. ;;获取第一个属性图元
  57. (setq ATTPART NIL)
  58. (while ENT
  59.    (setq ELIST (entget ENT))
  60.    (if (= (cdr (assoc 0 ELIST)) "ATTRIB")
  61.      (progn
  62.        (setq ALIGN1 (cdr (assoc 72 ELIST)))
  63.        (cond
  64.   ((= ALIGN1 0)
  65.    (setq P0 (cdr (assoc 10 ELIST)))
  66.    (setq TXB (textbox ELIST))
  67.    (setq WIDTH (- (car (cadr TXB)) (car (car TXB))))
  68.    (setq P0 (list (+ (/ WIDTH 2.0) (car P0)) (cadr P0) 0))
  69.   )
  70.   ((= ALIGN1 1)
  71.    (setq P0 (cdr (assoc 11 ELIST)))
  72.    (setq TXB (textbox ELIST))
  73.    (setq WIDTH (- (car (cadr TXB)) (car (car TXB))))
  74.   )
  75.   ((= ALIGN1 2)
  76.    (setq P0 (cdr (assoc 11 ELIST)))
  77.    (setq TXB (textbox ELIST))
  78.    (setq WIDTH (- (car (cadr TXB)) (car (car TXB))))
  79.    (setq P0 (list (- (car P0) (/ WIDTH 2.0)) (cadr P0) 0))
  80.   )
  81.        )
  82.        (if (and (> (car P0) (car P1))
  83.          (< (car P0) (car P2))
  84.          (> WIDTH (abs (- (car P1) (car P2))))
  85.     )
  86.   (progn
  87.     (setq PT2 (cadr P0))
  88.     (setq
  89.       PT2 (list (/ (+ (car P2) (car P1)) 2.0)
  90.          PT2
  91.          0
  92.    )
  93.     )
  94.     (setq KDBL (cdr (assoc 41 ELIST)))
  95.     (setq PT_LST (textbox ELIST))
  96.     (setq LEN (- (caadr PT_LST) (caar PT_LST)))
  97.     (setq KDBL (* KDBL
  98.     (/ (- (abs (- (car P2) (car P1))) 1.2)
  99.        (+ 2 LEN)
  100.     )
  101.         )
  102.     )
  103.     (setq ELIST
  104.     (subst (cons 72 1) (assoc 72 ELIST) ELIST)
  105.     )
  106.     (setq ELIST
  107.     (subst (cons 11 PT2) (assoc 11 ELIST) ELIST)
  108.     )
  109.     (setq ELIST
  110.     (subst (cons 41 KDBL) (assoc 41 ELIST) ELIST)
  111.     )
  112.     (entmod ELIST)
  113.   )
  114.        )
  115.      )
  116.    )
  117.    (setq ENT (entnext ENT))
  118. )
  119. (entupd (ssname SS I))
  120.       )
  121.     )
  122.     (setq I (+ I 1))
  123.   )
  124.   (princ)
  125. )
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-6-25 15:10 , Processed in 0.146653 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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