靠近文本实体的点绘制

teknomatika · 发表于 2022-7-5 22:59:02

我寻找一个可以解决以下任务的例程：

1-我选择一组文本实体（在本例中为数字）
2-然后在1的位置附近画一个点
3-最后，例程必须能够复制其他文本字符串中的点，保持步骤2中定义的相同密切关系

附上一张图纸以便更好地理解
坦克求救！
cadtutor\u测试点。图纸

JamCAD · 发表于 2022-7-5 23:03:50

试试这个

copy


(defun c:txtpt (/ txt1 txtpt pt ss i ptsz ang dist ip pt1 pt2 pt3 pt4)
 (setq    txt1  (progn (princ "Pick First M/Text Object")
            (ssget "_+.:E:S" '((0 . "*TEXT")))
         )
   txtpt (cdr (assoc 10 (entget (ssname txt1 0))))
   pt    (getpoint txtpt "\nSelect loction of point")
   ss    (progn (princ "Select All M/Text Objects")
            (ssget '((0 . "*TEXT")))
         )
   i     0
   ptsz  (getreal "\nHow large should the point be?")
   ang
         (angle txtpt pt)
   dist
         (distance txtpt pt)
 )
 (while (< i (sslength ss))
   (setq ip  (polar
       (cdr (assoc 10 (entget (ssname ss i))))
       ang
       dist
         )
     pt1 (polar ip (/ pi 2) (/ ptsz 2))
     pt2 (polar ip (* pi 1.5) (/ ptsz 2))
     pt3 (polar ip 0 (/ ptsz 2))
     pt4 (polar ip pi (/ ptsz 2))
   )
   (command "line" pt1 pt2 "")
   (command "line" pt3 pt4 "")
   (command "circle" ip (/ ptsz 4))
   (setq i (1+ i))
 )
)

teknomatika · 发表于 2022-7-5 23:11:06

就是这样。但是，没有必要像我的示例中那样绘制符号。我的意图是将其解释为一个观点。我只想画一个简单的点实体。

我感谢你的更新。

teknomatika · 发表于 2022-7-5 23:15:42

我认为这种方式解决了我想要的。

copy

(defun c:txtpt (/ txt1 txtpt pt ss i ptsz ang dist ip)
 (setq    txt1  (progn (princ "Pick First M/Text Object")
            (ssget "_+.:E:S" '((0 . "*TEXT")))
         )
   txtpt (cdr (assoc 10 (entget (ssname txt1 0))))
   pt    (getpoint txtpt "\nSelect loction of point")
   ss    (progn (princ "Select All M/Text Objects")
            (ssget '((0 . "*TEXT")))
         )
   i     0
   ang
         (angle txtpt pt)
   dist
         (distance txtpt pt)
 )
 (while (< i (sslength ss))
   (setq ip  (polar
       (cdr (assoc 10 (entget (ssname ss i))))
       ang
       dist
         )
   )
   (command "point" ip)
   (setq i (1+ i))
 )
)

pBe · 发表于 2022-7-5 23:19:03

copy

(command "point" [b]"_non"[/b] ip)

teknomatika · 发表于 2022-7-5 23:22:40

pBe，
坦克！

Tharwat · 发表于 2022-7-5 23:26:20

尝试

copy


(defun c:Test (/ *error* c s n sn e aa ab ac)
 ;;    Tharwat 23.05.2014        ;;
 (defun *error* (msg)
   (command "_.ucs" "_w")
   (if c (setvar 'cmdecho c))
   (if (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")
     (princ msg)
     (princ (strcat "Error : < ** " msg " ** >"))
   )
 )
 (if (zerop (getvar 'PDMODE))
   (setvar 'PDMODE 34)
 )
 (setq c (getvar 'cmdecho))
 (setvar 'cmdecho 0)
 (if (setq s (ssget '((0 . "TEXT"))))
   (repeat (setq n (sslength s))
     (setq sn (ssname s (setq n (1- n))))
     (setq e (textbox (list
                        (cons -1 sn)
                      )
             )
     )
     (command "_.ucs" "Object" sn)
     (setq aa (car e)
           ab (cadr e)
           ac (list (car ab) (cadr aa))
     )
     (command "_.point"
              "_non"
              (list (car ac)
                    (- (cadr ac) (/ (cdr (assoc 40 (entget sn))) 2.))
              )
     )
   )
 )
 (command "_.ucs" "_w")
 (setvar 'cmdecho c)
 (princ)
)