画完矩形后中心添加文字插件问题求助，谢谢~

逗亦斗霸 · 发表于 2024-8-8 10:07:20

(defun HRectang (p str)
(command "_.Rectang" p (strcat "@" (vl-string-translate "X" "," str)))
)
(defun c:ccc (/ lst p str pt_xy i p0 p1 p2 pp s1 ss )
(setq lst '("1000X1000"))
(foreach x lst
(setq p nil)
(cond ((setq p (getpoint "\n插入点")) (HRectang p x)))
)
(while (= 1 (getvar "cmdactive") ) (command pause) )
(command "rotate" (entlast) "" pause) (command pause)
(defun pt_xy (e / s)
(if (setq s
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= (car x) 10))(entget e))
)
)
(if (= 1 (length s))(car s)s)
)
)
(setq i -1)
(if (setq ss (ssget ":e" (list '(0 . "lwpolyline"))))
(while (and(setq s1 (ssname ss (setq i (1+ i)))))
(setq pp(pt_xy s1)
p1(car pp)
p2(caddr pp)
)
(setq p0(mapcar '(lambda(x)(* 0.5 x)) (mapcar '+ p1 p2)))
(entmake
(list (cons 0 "text")
(cons 1 "12345")
(cons 7 "standard")
(cons 10 p0)
(cons 11 p0)
(cons 40 180)
)))))

(defun HRectang        (p str)   
  (command "_.Rectang" p (strcat "@" (vl-string-translate "X" "," str)))   
) 
 
(defun c:ccc (/ lst p str pt_xy i p0 p1 p2 pp s1 ss ) 
    (setq lst '("1000X1000")) 
    (foreach x lst 
    (setq p nil) 
    (cond ((setq p (getpoint "\n插入点")) (HRectang p x))) 
  ) 
    (while (= 1 (getvar "cmdactive")  ) (command pause)  ) 
    (command "rotate" (entlast) "" pause) (command pause) 
    (defun pt_xy (e / s) 
                (if (setq s 
                                        (mapcar 'cdr 
                                                (vl-remove-if-not '(lambda (x) (= (car x) 10))(entget e)) 
                                        ) 
                                ) 
                        (if (= 1 (length s))(car s)s) 
                ) 
        ) 
    (setq i -1) 
    (if (setq ss (ssget ":e" (list '(0 . "lwpolyline")))) 
    (while (and(setq s1 (ssname ss (setq i (1+ i)))))                
                        (setq pp(pt_xy s1) 
                                 p1(car pp) 
                                 p2(caddr pp) 
                        ) 
                        (setq p0(mapcar '(lambda(x)(* 0.5 x)) (mapcar '+ p1 p2)))      
  (entmake 
    (list (cons 0 "text") 
           (cons 1 "12345") 
           (cons 7 "standard")   
           (cons 10 p0)               
           (cons 11 p0)               
           (cons 40 180) 
    )))))

1.插件目前是生成矩形后再点击，选择矩形基点后旋转，可否改成通过鼠标滑动指向改变矩形生成的方向，类似于动态生成？

2.矩形生成并旋转后需要点击一下矩形才能在其中心生成文字，请问可否取消点击矩形这个步骤，在确定矩形生成后文字随之在其中心生成？
谢谢~

飞雪神光 · 发表于 2024-8-9 20:41:49

逗亦斗霸发表于 2024-8-9 20:08
再请教一下飞版，我尝试把(setq ss(ssget))删除，并把后面的俩ss换成ty为什么不能像居中生成文字一样生成 ...

ssget 是选择集后面代码也是选择集的写法我觉得你是想象之前那样单个的绘制

(defun c:cdc (/ ff lst lst1 lst2 p pt_xy str ty)
(defun pt_xy (e / s)
(if (setq s
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= (car x) 10))(entget e))
)
)
(if (= 1 (length s))(car s)s)
)
)
(defun ff(lst)
(entmakex (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(62 . 256)
(cons 90 (length lst))
(cons 70 0)
)
(mapcar '(lambda (pt) (cons 10 pt)) lst)
)
)
)
(setq str "1000X1000")
(setq p (getpoint "\n插入点"))
(command "_.Rectang" "non" p "non" (strcat "@" (vl-string-translate "X" "," str)))
(setq ty (entlast))
(command "rotate" ty "" p)
(command pause)
(setq lst(pt_xy ty))
(setq lst1(list(car lst ) (caddr lst )))
(setq lst2(list(cadr lst )(cadddr lst )))
(ff lst1)
(ff lst2)
(princ)
)

(defun c:cdc (/ ff lst lst1 lst2 p pt_xy str ty) 
        (defun pt_xy (e / s) 
                (if (setq s 
                                        (mapcar 'cdr 
                                                (vl-remove-if-not '(lambda (x) (= (car x) 10))(entget e)) 
                                        ) 
                                ) 
                        (if (= 1 (length s))(car s)s) 
                ) 
        ) 
        (defun ff(lst) 
                (entmakex (append (list '(0 . "LWPOLYLINE") 
                                                                                                '(100 . "AcDbEntity") 
                                                                                                '(100 . "AcDbPolyline") 
                                                                                                '(62 . 256) 
                                                                                                (cons 90 (length lst)) 
                                                                                                (cons 70 0) 
                                                                                        ) 
                                                                (mapcar '(lambda (pt) (cons 10 pt)) lst) 
                                                        ) 
                ) 
        ) 
        (setq str "1000X1000") 
        (setq p (getpoint "\n插入点")) 
        (command "_.Rectang" "non" p "non" (strcat "@" (vl-string-translate "X" "," str))) 
        (setq ty (entlast)) 
        (command "rotate" ty "" p) 
        (command pause) 
        (setq lst(pt_xy ty)) 
        (setq lst1(list(car lst ) (caddr lst ))) 
        (setq lst2(list(cadr lst )(cadddr lst ))) 
        (ff lst1) 
        (ff lst2) 
        (princ)         
)

飞雪神光 · 发表于 2024-8-8 16:11:01

逗亦斗霸发表于 2024-8-8 15:44
感谢飞版回复，我把(command "rotate" ty "" p0) (command pause)改成(command "rotate" ty "" p) (comma ...

72 73是基点对齐模式不对就删掉

(defun c:ccc (/ p p0 p1 p2 pp pt_xy str ty)
(defun pt_xy (e / s)
(if (setq s
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= (car x) 10))(entget e))
)
)
(if (= 1 (length s))(car s)s)
)
)
(setq str "1000X1000")
(setq p (getpoint "\n插入点"))
(command "_.Rectang" "non" p "non" (strcat "@" (vl-string-translate "X" "," str)))
(setq ty (entlast))
(command "rotate" ty "" p)
(command pause)
(setq
pp(pt_xy ty)
p1(car pp)
p2(caddr pp)
)
(setq p0(mapcar '(lambda(x)(* 0.5 x)) (mapcar '+ p1 p2)))
(entmake
(list
(cons 0 "text")
(cons 1 "12345")
(cons 7 "standard")
(cons 10 p0)
(cons 11 p0)
(cons 40 180)
'(72 . 1)
'(73 . 2)
)
)
(princ)
)

(defun c:ccc (/ p p0 p1 p2 pp pt_xy str ty) 
        (defun pt_xy (e / s) 
                (if (setq s 
                                        (mapcar 'cdr 
                                                (vl-remove-if-not '(lambda (x) (= (car x) 10))(entget e)) 
                                        ) 
                                ) 
                        (if (= 1 (length s))(car s)s) 
                ) 
        ) 
        (setq str "1000X1000") 
        (setq p (getpoint "\n插入点")) 
        (command "_.Rectang" "non" p "non" (strcat "@" (vl-string-translate "X" "," str))) 
        (setq ty (entlast)) 
        (command "rotate" ty "" p) 
        (command pause) 
        (setq 
                pp(pt_xy ty) 
                p1(car pp) 
                p2(caddr pp) 
        ) 
        (setq p0(mapcar '(lambda(x)(* 0.5 x)) (mapcar '+ p1 p2))) 
        (entmake 
                (list 
                        (cons 0 "text") 
                        (cons 1 "12345") 
                        (cons 7 "standard")   
                        (cons 10 p0)               
                        (cons 11 p0)               
                        (cons 40 180) 
                        '(72 . 1) 
                        '(73 . 2) 
                ) 
        ) 
        (princ)        
)

逗亦斗霸 · 发表于 2024-8-9 20:08:27

飞雪神光发表于 2024-8-8 16:11
72 73是基点对齐模式不对就删掉

(defun c:cdc (/ p p0 p1 p2 pp pt_xy str ty I LST LST1 LST2 PT ss)
(defun pt_xy (e / s)
(if (setq s
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= (car x) 10))(entget e))
)
)
(if (= 1 (length s))(car s)s)
)
)
(setq str "1000X1000")
(setq p (getpoint "\n插入点"))
(command "_.Rectang" "non" p "non" (strcat "@" (vl-string-translate "X" "," str)))
(setq ty (entlast))
(command "rotate" ty "" p)
(command pause)
(setq ss(ssget))
(defun ff(lst)
(entmakex (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(62 . 256)
(cons 90 (length lst))
(cons 70 0)
)
(mapcar '(lambda (pt) (cons 10 pt)) lst)
)
))
(repeat(setq i(sslength ss))
(setq lst(mapcar 'cdr(vl-remove-if-not '(lambda(x)(=(car x) 10)) (entget(ssname ss(setq i(1- i)))))))
(setq lst1(list(car lst ) (caddr lst )))
(setq lst2(list(cadr lst )(cadddr lst )))
(ff lst1) (ff lst2)
)
(princ)
)

(defun c:cdc (/ p p0 p1 p2 pp pt_xy str ty I LST LST1 LST2 PT ss) 
        (defun pt_xy (e / s) 
                (if (setq s 
                                        (mapcar 'cdr 
                                                (vl-remove-if-not '(lambda (x) (= (car x) 10))(entget e)) 
                                        ) 
                                ) 
                        (if (= 1 (length s))(car s)s) 
                ) 
        ) 
        (setq str "1000X1000") 
        (setq p (getpoint "\n插入点")) 
        (command "_.Rectang" "non" p "non" (strcat "@" (vl-string-translate "X" "," str))) 
        (setq ty (entlast)) 
        (command "rotate" ty "" p) 
        (command pause) 
        (setq ss(ssget)) 
    (defun ff(lst) 
        (entmakex (append (list '(0 . "LWPOLYLINE") 
        '(100 . "AcDbEntity") 
        '(100 . "AcDbPolyline") 
        '(62 . 256) 
        (cons 90 (length lst)) 
        (cons 70 0) 
        ) 
        (mapcar '(lambda (pt) (cons 10 pt)) lst) 
      ) 
  )) 
  (repeat(setq i(sslength ss)) 
    (setq lst(mapcar 'cdr(vl-remove-if-not '(lambda(x)(=(car x) 10)) (entget(ssname ss(setq i(1- i))))))) 
     (setq lst1(list(car lst ) (caddr lst ))) 
     (setq lst2(list(cadr lst )(cadddr lst ))) 
     (ff lst1) (ff lst2) 
  ) 
          (princ)         
)

再请教一下飞版，我尝试把(setq ss(ssget))删除，并把后面的俩ss换成ty为什么不能像居中生成文字一样生成对角线？谢谢~

飞雪神光 · 发表于 2024-8-8 12:44:30

(defun c:ccc (/ p p0 p1 p2 pp pt_xy str ty)
(defun pt_xy (e / s)
(if (setq s
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= (car x) 10))(entget e))
)
)
(if (= 1 (length s))(car s)s)
)
)
(setq str "1000X1000")
(setq p (getpoint "\n插入点"))
(command "_.Rectang" "non" p "non" (strcat "@" (vl-string-translate "X" "," str)))
(setq ty (entlast))
(setq
pp(pt_xy ty)
p1(car pp)
p2(caddr pp)
)
(setq p0(mapcar '(lambda(x)(* 0.5 x)) (mapcar '+ p1 p2)))
(command "rotate" ty "" p0) (command pause)
(entmake
(list
(cons 0 "text")
(cons 1 "12345")
(cons 7 "standard")
(cons 10 p0)
(cons 11 p0)
(cons 40 180)
)
)
(princ)
)

(defun c:ccc (/ p p0 p1 p2 pp pt_xy str ty) 
        (defun pt_xy (e / s) 
                (if (setq s 
                                        (mapcar 'cdr 
                                                (vl-remove-if-not '(lambda (x) (= (car x) 10))(entget e)) 
                                        ) 
                                ) 
                        (if (= 1 (length s))(car s)s) 
                ) 
        ) 
        (setq str "1000X1000") 
        (setq p (getpoint "\n插入点")) 
        (command "_.Rectang" "non" p "non" (strcat "@" (vl-string-translate "X" "," str))) 
        (setq ty (entlast)) 
        (setq 
                pp(pt_xy ty) 
                p1(car pp) 
                p2(caddr pp) 
        ) 
        (setq p0(mapcar '(lambda(x)(* 0.5 x)) (mapcar '+ p1 p2))) 
        (command "rotate" ty "" p0) (command pause) 
        (entmake 
                (list 
                        (cons 0 "text") 
                        (cons 1 "12345") 
                        (cons 7 "standard")   
                        (cons 10 p0)               
                        (cons 11 p0)               
                        (cons 40 180) 
                ) 
        ) 
        (princ)        
)

逗亦斗霸 · 发表于 2024-8-8 15:44:34

飞雪神光发表于 2024-8-8 12:44

感谢飞版回复，我把(command "rotate" ty "" p0) (command pause)改成(command "rotate" ty "" p) (command pause)后是想我生成的矩形的形式，但是随后生成的文字不在所生成的矩形框中点上，再请教一下怎么改？谢谢谢谢~

gble119 · 发表于 2024-8-8 22:08:01

路过学习了。

逗亦斗霸 · 发表于 2024-8-9 14:54:00

飞雪神光发表于 2024-8-8 16:11
72 73是基点对齐模式不对就删掉

再次感谢飞版，正是我想要的插件，学习了~

muai2010 · 发表于 2024-8-9 15:47:03

路过，感谢分享

饼仲郎 · 发表于 2024-8-9 19:27:50

entmake生成单行文字http://bbs.mjtd.com/thread-180267-1-1.html，有好多问题用关键词搜一下能找多好多类似的

逗亦斗霸 · 发表于 2024-8-9 19:39:26

饼仲郎发表于 2024-8-9 19:27
entmake生成单行文字http://bbs.mjtd.com/thread-180267-1-1.html，有好多问题用关键词搜一下能找多好多类 ...

是的，我搜索过了，但逐一看了也没找到我想要的代码，所以才来求助了，根据飞版的指点和其他人的代码，居中生成多行文字的也搞定了，谢谢~

账号		自动登录	找回密码
密码			注册

[提问] 画完矩形后中心添加文字插件问题求助，谢谢~