乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 ☆ ☆ ☆ 尊重版权，从我做起，拒绝盗版，拒绝倒卖 ☆ ☆ ☆ 签到、发布资源、邀请好友注册，可以获得银币 ☆ ☆ ☆ 请注意保管好自己的密码，避免账户资金被盗
查看： 87|回复： 1

[编程交流] 绘制动态文本和线条。

[复制链接]
blueshake

22

主题

100

帖子

78

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
112
发表于 2022-7-6 10:15:42 | 显示全部楼层 |阅读模式
大家好
以下代码用于绘制动态文字和线条。
如图所示。

                               
登录/注册后可看大图

 
但错误总是发生。调试之后。
我发现这些代码中存在代码。
  1. (setq text (vla-addtext mSpace fh (vlax-3d-point nextPt)))

 
 
整个计划。感谢您抽出时间阅读本文。
  1. (defun c:tt(/)
  2.          (vl-load-com)
  3. (defun *error* (msg)
  4.         (setvar "osmod" osmode_old)
  5. )
  6. (defun text_length (Text / textent ang sinrot cosrot t1 t2 p0 p1 p2 p3 p4)
  7.         (setq         textent (entget (vlax-vla-object->ename Text)))
  8.         (setq         p0  (cdr (assoc 10 textent))
  9.                         ang  (cdr (assoc 50 textent))
  10.                         sinrot (sin ang)
  11.                         cosrot (cos ang)
  12.                         t1  (car (textbox textent))
  13.                         t2  (cadr (textbox textent))
  14.                         p1  (list (+ (car p0) (- (* (car t1) cosrot) (* (cadr t1) sinrot)))
  15.                                 (+ (cadr p0)
  16.                                 (+ (* (car t1) sinrot) (* (cadr t1) cosrot))
  17.                                 )
  18.                                 )
  19.                         p2  (list
  20.                                 (+ (car p0)
  21.                                 (- (* (car t2) cosrot) (* (cadr t1) sinrot))
  22.                                 )
  23.                                 (+ (cadr p0)
  24.                                 (+ (* (car t2) sinrot) (* (cadr t1) cosrot))
  25.                                 )
  26.                                 )
  27.         )
  28.                         (distance p1 p2)
  29. ) 
  30. (setq mSpace (vla-get-ModelSpace(vla-get-ActiveDocument (vlax-get-acad-object))))
  31.          (setq entbak (ssadd))
  32.          (setq osmode_old (getvar "osmode"))
  33.          (setvar "osmode" 0)
  34.          (setq pt (getpoint "\nget the center point."))
  35.          (command "_.circle" pt)
  36.           (princ (strcat "\ninput the radius of circle"))
  37.          (command pause)
  38.          (setq cir (vlax-ename->vla-object (entlast)))
  39.          (ssadd (entlast) entbak)
  41.          ;start to input the makr.
  42.          (setq hasMore T)
  43.          (while hasMore
  44.           (setq nextPt (grread T 4 0)
  45.                      readtype (car nextPt)
  46.                      readvale (cadr nextPt)
  47.         )
  49.     (cond ((= readtype 5)
  50.                                 (setq nextPt (cadr nextPt))
  51.                                 (setq nextPt (trans nextPt 1 0))
  52.                                 (setq basePt (vlax-curve-getclosestpointto cir nextPt))
  53.                                 (if (not line)
  54.                                         (progn
  55.                                                 (if (not fh)
  56.                                                         (setq fh "A")
  57.                                                 )
  58.                                                 (setq text (vla-addtext mSpace fh (vlax-3d-point nextPt)))
  59.                                                 (ssadd (entlast) entbak)
  60.                                                 (setq txtlen (text_length text))
  61.                                                 (setq l2end (vla-addline mSpace (vlax-3d-point nextPt) (vlax-3d-point l2end)))
  62.                                         )
  63.                                         (progn
  64.                                                 (vla-put-startpoint line (vlax-3d-point basePt))
  65.                                                 (vla-put-endpoint line (vlax-3d-point nextPt))
  66.                                                 (vla-update line)
  67.                                                 (setq ptt (car nextPt))
  68.                                                 (if (> ptt pt)
  69.                                                         (progn
  70.                                                                 (setq textleft (+ (car nextPt) (getvar "dimgap")))
  71.                                                                 (setq l2left (+ (car nextPt) txtlen (getvar "dimgap")))
  72.                                                         )
  73.                                                         (progn
  74.                                                                 (setq textleft (- (car nextPt) (getvar "dimgap") txtlen))
  75.                                                                 (setq l2left textleft)
  76.                                                         )
  77.                                                 )
  78.                                                 (vla-put-insertionpoint text (vlax-3d-point list textleft (+ (cadr nextPt) (getvar "dimgap")) 0))
  79.                                                 (vla-update text)
  80.                                                 (vla-put-startpoint l2 (vlax-3d-point nextPt))
  81.                                                 (setq l2end (list l2left (cadr nextPt) 0))
  82.                                                 (vla-put-endpoint l2 (vlax-3d-point l2end))
  83.                                                 (vla-update l2)
  84.                                         )
  85.                                 )        
  86.                    )
  87.                    ((= readtype 3)
  88.                                 (setq i nil)
  89.                    )
  90.                    ((or (= 25 readtype) (= 13 readtype))
  91.                                 ;(
  92.                    )
  93.         )
  94. )
  95. )
回复

使用道具 举报

blueshake

22

主题

100

帖子

78

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
112
发表于 2022-7-6 11:20:46 | 显示全部楼层
找出原因。应该是：
  1. (setq text (vla-addtext mSpace fh (vlax-3d-point nextPt) (getvar "dimtxt")))

 
更新的代码：
  1. (defun c:tt(/ line fh text)
  2.          (vl-load-com)
  3. (defun *error* (msg)
  4.         (setvar "osmod" osmode_old)
  5. )
  6. (defun text_length (Text / textent ang sinrot cosrot t1 t2 p0 p1 p2 p3 p4)
  7.         (setq         textent (entget (vlax-vla-object->ename Text)))
  8.         (setq         p0  (cdr (assoc 10 textent))
  9.                         ang  (cdr (assoc 50 textent))
  10.                         sinrot (sin ang)
  11.                         cosrot (cos ang)
  12.                         t1  (car (textbox textent))
  13.                         t2  (cadr (textbox textent))
  14.                         p1  (list (+ (car p0) (- (* (car t1) cosrot) (* (cadr t1) sinrot)))
  15.                                 (+ (cadr p0)
  16.                                 (+ (* (car t1) sinrot) (* (cadr t1) cosrot))
  17.                                 )
  18.                                 )
  19.                         p2  (list
  20.                                 (+ (car p0)
  21.                                 (- (* (car t2) cosrot) (* (cadr t1) sinrot))
  22.                                 )
  23.                                 (+ (cadr p0)
  24.                                 (+ (* (car t2) sinrot) (* (cadr t1) cosrot))
  25.                                 )
  26.                                 )
  27.         )
  28.                         (distance p1 p2)
  29. ) 
  30. (setq mSpace (vla-get-ModelSpace(vla-get-ActiveDocument (vlax-get-acad-object))))
  31.          (setq entbak (ssadd))
  32.          (setq osmode_old (getvar "osmode"))
  33.          (setvar "osmode" 0)
  34.          (setq pt (getpoint "\nget the center point."))
  35.          (command "_.circle" pt)
  36.           (princ (strcat "\ninput the radius of circle"))
  37.          (command pause)
  38.          (setq cir (vlax-ename->vla-object (entlast)))
  39.          (ssadd (entlast) entbak)
  41.          ;start to input the makr.
  42.          (setq hasMore T)
  43.          (while hasMore
  44.           (setq nextPt (grread T 4 0)
  45.                      readtype (car nextPt)
  46.                      readvale (cadr nextPt)
  47.         )
  49.     (cond ((= readtype 5)
  50.                                 (setq nextPt (cadr nextPt))
  51.                                 (setq nextPt (trans nextPt 1 0))
  52.                                 (setq basePt (vlax-curve-getclosestpointto cir nextPt))
  53.                                 (if (not line)
  54.                                         (progn
  55.                                                 (if (not fh)
  56.                                                         (setq fh "A")
  57.                                                 )
  58.                                                 (setq text (vla-addtext mSpace fh (vlax-3d-point nextPt) (getvar "dimtxt")))
  59.                                                 (ssadd (entlast) entbak)
  60.                                                 ;(setq txtlen (text_length text))
  61.                                                 (setq line (vla-addline mSpace (vlax-3d-point basePt) (vlax-3d-point nextPt)))
  62.                                                 (ssadd (entlast) entbak)
  63.                                                 (setq txtlen (text_length text))
  64.                                                 (setq l2end (list (+ (car nextPt) txtlen) (cadr nextPt) 0))
  65.                                                 (setq l2 (vla-addline mspace (vlax-3d-point nextPt) (vlax-3d-point l2end)))
  66.                                                 (ssadd (entlast) entbak)
  67.                                         )
  68.                                         (progn
  69.                                                 (vla-put-startpoint line (vlax-3d-point basePt))
  70.                                                 (vla-put-endpoint line (vlax-3d-point nextPt))
  71.                                                 (vla-update line)
  72.                                                 (setq ptt (car nextPt))
  73.                                                 (setq ptx (car pt))
  74.                                                 (if (> ptt ptx)
  75.                                                         (progn
  76.                                                                 (setq textleft (+ (car nextPt) (getvar "dimgap")))
  77.                                                                 (setq l2left (+ (car nextPt) txtlen (getvar "dimgap")))
  78.                                                         )
  79.                                                         (progn
  80.                                                                 (setq textleft (- (car nextPt) (getvar "dimgap") txtlen))
  81.                                                                 (setq l2left textleft)
  82.                                                         )
  83.                                                 )
  84.                                                 (vla-put-insertionpoint text (vlax-3d-point (list textleft (+ (cadr nextPt) (getvar "dimgap")) 0)))
  85.                                                 (vla-update text)
  86.                                                 (vla-put-startpoint l2 (vlax-3d-point nextPt))
  87.                                                 (setq l2end (list l2left (cadr nextPt) 0))
  88.                                                 (vla-put-endpoint l2 (vlax-3d-point l2end))
  89.                                                 (vla-update l2)
  90.                                         )
  91.                                 )        
  92.                    )
  93.                    ((= readtype 3)
  94.                                 (setq hasMore nil)
  95.                    )
  96.                    ((or (= 25 readtype) (= 13 readtype))
  97.                                 ;(
  98.                    )
  99.         )
  100. )
  101. )
回复

使用道具 举报

返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-6 21:16 , Processed in 0.419744 second(s), 60 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表