大师求助，为何直线没有在标注下，而是在标注线上？

ferious · 发表于 2023-11-12 00:11:48

(defun c:bzl(/ ss ssh ssv i ent rate
pt dim n dimstyle ssdimstyle
ssdimstyle hz0 hzqj hz hb pt2x
pt1x pt1y pt2y pt1 pt2
)
(setvar "cmdecho" 0)
(princ "\n选择标注集合")
(setq ss (ssget '((0 . "DIMENSION"))))
(setq ssh (ssadd))
(setq ssv (ssadd))
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
(if (= 0 (cdr (assoc 50 (entget ent))));cdr对点对列表操作掐头，cadr有问题
(setq ssh (ssadd ent ssh))
(setq ssv (ssadd ent ssv))
)
(setq i (1+ i))
(princ (sslength ssh))
(princ "\n")
(princ (sslength ssv))
(prin1)
);end repeat;选择集分开为横竖
(setq i 0)
(setq rate 0.2);0.2为和有问题？
(repeat (sslength ssh)
(setq ent (ssname ssh i))
(setq pt (cdr (assoc 10 (entget ent))))
(setq dim (cdr (assoc 42 (entget ent))))
(setq n (1+ (fix (/ (log dim) (log 10)))))
(setq dimstyle (cdr (assoc 3 (entget ent))))
(setq ssdimstyle (tblobjname "DIMSTYLE" dimstyle))
;标注样式名反选标注样式
(setq hz0 (cdr (assoc 140 (entget ssdimstyle)))) ;标注样式文字高度
(setq hzqj (cdr (assoc 40 (entget ssdimstyle))))
;全局比例为1返回空值
(if (= nil hzqj)
(setq hzqj 1)
)
(setq hz (* hzqj hz0))
(setq hb (* hz n))
(setq pt2x (- (car pt) (abs (* 0.5 (- hb dim)))))
(setq pt1x (- pt2x hb))
(setq gaodu (* hz rate))
(setq pt1y (- (cadr pt) (* hz rate)))
(setq pt2y pt1y)
(setq pt1 (list pt1x pt1y (caddr pt) ))
(setq pt2 (list pt2x pt2y (caddr pt) ))
;(command "circle" pt1 6)
(command "line" pt1 pt2 "")
(setq i (1+ i))
);end repeat
(prin1)
)

(defun c:bzl(/   ss      ssh     ssv     i        ent    rate 
        pt      dim     n        dimstyle        ssdimstyle 
        ssdimstyle      hz0     hzqj   hz      hb      pt2x 
        pt1x    pt1y    pt2y    pt1     pt2 
       ) 
  (setvar "cmdecho" 0) 
  (princ "\n选择标注集合") 
  (setq ss (ssget '((0 . "DIMENSION")))) 
  (setq ssh (ssadd)) 
  (setq ssv (ssadd)) 
  (setq i 0) 
  (repeat (sslength ss) 
         
          
    (setq ent (ssname ss i)) 
    (if  (= 0 (cdr (assoc 50 (entget ent))));cdr对点对列表操作掐头，cadr有问题 
      (setq ssh (ssadd ent ssh)) 
      (setq ssv (ssadd ent ssv)) 
    ) 
    (setq i (1+ i)) 
    (princ (sslength ssh)) 
    (princ "\n") 
    (princ (sslength ssv)) 
    (prin1) 
  );end repeat;选择集分开为横竖 
   
  (setq i 0) 
  (setq rate 0.2);0.2为和有问题？ 
 
  (repeat (sslength ssh) 
    (setq ent (ssname ssh i)) 
    (setq pt (cdr (assoc 10 (entget ent)))) 
    (setq dim (cdr (assoc 42 (entget ent)))) 
    (setq n (1+ (fix (/ (log dim) (log 10))))) 
    (setq dimstyle (cdr (assoc 3 (entget ent)))) 
    (setq ssdimstyle (tblobjname "DIMSTYLE" dimstyle)) 
          ;标注样式名反选标注样式 
    (setq hz0 (cdr (assoc 140 (entget ssdimstyle)))) ;标注样式文字高度 
 
 
    (setq hzqj (cdr (assoc 40 (entget ssdimstyle)))) 
          ;全局比例为1返回空值 
    (if  (= nil hzqj) 
      (setq hzqj 1) 
    ) 
 
    (setq hz (* hzqj hz0)) 
    (setq hb (* hz n)) 
    (setq pt2x (- (car pt) (abs (* 0.5 (- hb dim))))) 
    
    (setq pt1x (- pt2x hb)) 
    (setq gaodu (* hz rate)) 
    (setq pt1y (- (cadr pt) (* hz rate))) 
    (setq pt2y pt1y) 
    (setq pt1 (list pt1x pt1y (caddr pt) )) 
    (setq pt2 (list pt2x pt2y (caddr pt) )) 
    ;(command "circle" pt1 6) 
    (command "line" pt1 pt2 "") 
    (setq i (1+ i)) 
  );end repeat 
 
  (prin1) 
)

飞雪神光 · 发表于 2024-1-5 20:24:40

本帖最后由飞雪神光于 2024-1-5 20:44 编辑

(defun c:ddr (/ bili crpt en get-dxf huajuxing l lm-entmake-layer lm-entmake-pline lm-getmtextbox1 obj pts ss ss-enlst tc tylx zg)
(defun get-dxf(en n)
(if (not (listp en)) (setq en (entget en)))
(cdr (assoc n en))
)
(defun ss-enlst (ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
)
)
(defun lm-getmtextbox1 (obj offh offs / MXV B ENX H J L M N O P R W)
(Defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)
(setq enx (entget obj))
(if (null off)
(setq off 0.0)
)
(if
(setq l
(cond
((= "TEXT" (cdr (assoc 0 enx)))
(setq b (cdr (assoc 10 enx))
r (cdr (assoc 50 enx))
l (textbox enx)
)
(list
(list (- (caar l) offh) (- (cadar l) offs))
(list (+ (caadr l) offh) (- (cadar l) offs))
(list (+ (caadr l) offh) (+ (cadadr l) offs))
(list (- (caar l) offh) (+ (cadadr l) offs))
)
)
((= "MTEXT" (cdr (assoc 0 enx)))
(setq n (cdr (assoc 210 enx))
b (trans (cdr (assoc 10 enx)) 0 n)
r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))
w (cdr (assoc 42 enx))
h (cdr (assoc 43 enx))
j (cdr (assoc 71 enx))
o (list
(cond
((member j '(2 5 8)) (/ w -2.0))
((member j '(3 6 9)) (- w))
(0.0)
)
(cond
((member j '(1 2 3)) (- h))
((member j '(4 5 6)) (/ h -2.0))
(0.0)
)
)
)
(list
(list (- (car o) offh) (- (cadr o) offs))
(list (+ (car o) w offh) (- (cadr o) offs))
(list (+ (car o) w offh) (+ (cadr o) h offs))
(list (- (car o) offh) (+ (cadr o) h offs))
)
)
)
)
((lambda (m)
(mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)
)
(list
(list (cos r) (sin (- r)) 0.0)
(list (sin r) (cos r) 0.0)
'(0.0 0.0 1.0)
)
)
)
)
(defun lm-entmake-pline (pldata / a s1 ptlst bihe co tc h)
(mapcar'set '(ptlst bihe co tc) pldata)
(or co (setq co 256))
(or tc (setq tc (getvar "clayer")))
(entmake (append (list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 62 co)
(cons 8 tc)
(cons 90 (length ptlst))
(cons 70 (if bihe 1 0))
(cons 38 (if (setq h(nth 2 (car ptlst))) h 0))
)
(mapcar '(lambda (a) (cons 10 a)) ptlst))
)
(entlast)
)
(defun lm-entmake-layer(datalst)
(mapcar'set '(tc co) datalst)
(or co (setq co 256))
(or tc (setq tc (getvar "clayer")))
(entmake (list '(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")(cons 2 tc)(cons 62 co)'(70 . 0)'(6 . "CONTINUOUS")))
)
(princ "\n选择标注集合")
(setvar "cmdecho" 0)
(if(null(tblsearch "layer" "DGWT-REV"))
(lm-entmake-layer (list "DGWT-REV" 4))
)
(setq ss (ssget '((0 . "DIMENSION"))))
(foreach bzty (ss-enlst ss)
(setq obj (vlax-ename->vla-object bzty))
(setq en (get-dxf (tblsearch "block" (get-dxf bzty 2)) -2));获得标注的匿名图元块的文字图元名
(while (setq en(entnext en)) ;一直循环找到该匿名块中成员是文字为止
(setq tylx (get-dxf en 0))
(if (wcmatch tylx "*TEXT")
(progn
(setq zg(get-dxf en 40))
(setq pts (lm-getmtextbox1 en (* zg 0.7) (* zg 0.7)))
(lm-entmake-pline (list pts t nil nil))
(setq L (* 0.3 zg))
(setq huajuxing (entlast))
(command "revcloud" "S" "N" "a" L L "o" huajuxing "")
(vla-put-Layer (vlax-ename->vla-object (entlast)) "DGWT-REV")
)
)
)
)
(princ)
)

(defun c:ddr (/ bili crpt en get-dxf huajuxing l lm-entmake-layer lm-entmake-pline lm-getmtextbox1 obj pts ss ss-enlst tc tylx zg) 
  (defun get-dxf(en n) 
    (if (not (listp en)) (setq en (entget en))) 
    (cdr (assoc n en)) 
  ) 
  (defun ss-enlst (ss / enlst) 
    (cond 
      ((= (type ss) 'PICKSET) 
        (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS))) 
      ) 
      ((= (type ss) 'LIST) 
        (setq enlst (ssadd)) 
        (last (mapcar '(lambda (x) (ssadd x enlst)) ss)) 
      ) 
    ) 
  ) 
  (defun lm-getmtextbox1 (obj offh offs / MXV B ENX H J L M N O P R W) 
    (Defun mxv (m v) 
      (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m) 
    ) 
    (setq enx (entget obj)) 
    (if (null off) 
      (setq off 0.0) 
    ) 
    (if 
      (setq l 
        (cond 
          ((= "TEXT" (cdr (assoc 0 enx))) 
            (setq b (cdr (assoc 10 enx)) 
              r (cdr (assoc 50 enx)) 
              l (textbox enx) 
            ) 
            (list 
              (list (- (caar l) offh) (- (cadar l) offs)) 
              (list (+ (caadr l) offh) (- (cadar l) offs)) 
              (list (+ (caadr l) offh) (+ (cadadr l) offs)) 
              (list (- (caar l) offh) (+ (cadadr l) offs)) 
            ) 
          ) 
          ((= "MTEXT" (cdr (assoc 0 enx))) 
            (setq n (cdr (assoc 210 enx)) 
              b (trans (cdr (assoc 10 enx)) 0 n) 
              r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n)) 
              w (cdr (assoc 42 enx)) 
              h (cdr (assoc 43 enx)) 
              j (cdr (assoc 71 enx)) 
              o (list 
                  (cond 
                    ((member j '(2 5 8)) (/ w -2.0)) 
                    ((member j '(3 6 9)) (- w)) 
                    (0.0) 
                  ) 
                  (cond 
                    ((member j '(1 2 3)) (- h)) 
                    ((member j '(4 5 6)) (/ h -2.0)) 
                    (0.0) 
                  ) 
                ) 
            ) 
            (list 
              (list (- (car o) offh) (- (cadr o) offs)) 
              (list (+ (car o) w offh) (- (cadr o) offs)) 
              (list (+ (car o) w offh) (+ (cadr o) h offs)) 
              (list (- (car o) offh) (+ (cadr o) h offs)) 
            ) 
          ) 
        ) 
      ) 
      ((lambda (m) 
         (mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l) 
       ) 
        (list 
          (list (cos r) (sin (- r)) 0.0) 
          (list (sin r) (cos r) 0.0) 
          '(0.0 0.0 1.0) 
        ) 
      ) 
    ) 
  ) 
  (defun lm-entmake-pline (pldata / a s1 ptlst bihe co tc h) 
    (mapcar'set '(ptlst bihe co tc) pldata) 
    (or co (setq co 256)) 
    (or tc (setq tc (getvar "clayer"))) 
    (entmake (append (list 
                       '(0 . "LWPOLYLINE") 
                       '(100 . "AcDbEntity") 
                       '(100 . "AcDbPolyline") 
                       (cons 62 co) 
                       (cons 8 tc) 
                       (cons 90 (length ptlst)) 
                       (cons 70 (if bihe 1 0)) 
                       (cons 38 (if (setq h(nth 2 (car ptlst))) h 0)) 
                     ) 
               (mapcar '(lambda (a) (cons 10 a)) ptlst)) 
    ) 
    (entlast) 
  ) 
  (defun lm-entmake-layer(datalst) 
    (mapcar'set '(tc co) datalst) 
    (or co (setq co 256)) 
    (or tc (setq tc (getvar "clayer"))) 
    (entmake (list '(0 . "LAYER")'(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")(cons 2 tc)(cons 62 co)'(70 . 0)'(6 . "CONTINUOUS"))) 
  ) 
  (princ "\n选择标注集合") 
  (setvar "cmdecho" 0) 
  (if(null(tblsearch "layer" "DGWT-REV")) 
    (lm-entmake-layer (list "DGWT-REV" 4)) 
  ) 
  (setq ss (ssget '((0 . "DIMENSION")))) 
  (foreach bzty (ss-enlst ss) 
    (setq obj (vlax-ename->vla-object bzty)) 
    (setq en (get-dxf (tblsearch "block" (get-dxf bzty 2)) -2));获得标注的匿名图元块的文字图元名 
    (while (setq en(entnext en))  ;一直循环找到该匿名块中成员是文字为止 
      (setq tylx (get-dxf en 0)) 
      (if (wcmatch tylx "*TEXT") 
        (progn 
          (setq zg(get-dxf en 40)) 
          (setq pts (lm-getmtextbox1 en (* zg 0.7)  (* zg 0.7))) 
          (lm-entmake-pline (list pts t nil nil)) 
          (setq L (*  0.3 zg)) 
          (setq huajuxing (entlast)) 
          (command "revcloud" "S" "N" "a" L L "o" huajuxing "") 
          (vla-put-Layer (vlax-ename->vla-object (entlast)) "DGWT-REV") 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

飞雪神光 · 发表于 2023-11-12 09:36:55

(defun c:bzl (/ bili crpt en get-dxf lm-getmtextbox1 obj pts ss ss-enlst tc tylx zg)
(defun get-dxf(en n)
(if (not (listp en)) (setq en (entget en)))
(cdr (assoc n en))
)
(defun ss-enlst (ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
)
)
(defun lm-getmtextbox1 (obj offh offs / MXV B ENX H J L M N O P R W)
(Defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)
(setq enx (entget obj))
(if (null off)
(setq off 0.0)
)
(if
(setq l
(cond
((= "TEXT" (cdr (assoc 0 enx)))
(setq b (cdr (assoc 10 enx))
r (cdr (assoc 50 enx))
l (textbox enx)
)
(list
(list (- (caar l) offh) (- (cadar l) offs))
(list (+ (caadr l) offh) (- (cadar l) offs))
(list (+ (caadr l) offh) (+ (cadadr l) offs))
(list (- (caar l) offh) (+ (cadadr l) offs))
)
)
((= "MTEXT" (cdr (assoc 0 enx)))
(setq n (cdr (assoc 210 enx))
b (trans (cdr (assoc 10 enx)) 0 n)
r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))
w (cdr (assoc 42 enx))
h (cdr (assoc 43 enx))
j (cdr (assoc 71 enx))
o (list
(cond
((member j '(2 5 8)) (/ w -2.0))
((member j '(3 6 9)) (- w))
(0.0)
)
(cond
((member j '(1 2 3)) (- h))
((member j '(4 5 6)) (/ h -2.0))
(0.0)
)
)
)
(list
(list (- (car o) offh) (- (cadr o) offs))
(list (+ (car o) w offh) (- (cadr o) offs))
(list (+ (car o) w offh) (+ (cadr o) h offs))
(list (- (car o) offh) (+ (cadr o) h offs))
)
)
)
)
((lambda (m)
(mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)
)
(list
(list (cos r) (sin (- r)) 0.0)
(list (sin r) (cos r) 0.0)
'(0.0 0.0 1.0)
)
)
)
)
(princ "\n选择标注集合")
(setq ss (ssget '((0 . "DIMENSION"))))
(foreach bzty (ss-enlst ss)
(setq obj (vlax-ename->vla-object bzty))
(setq en (get-dxf (tblsearch "block" (get-dxf bzty 2)) -2));获得标注的图元名
(setq crpt(get-dxf bzty 11))
(setq tc(get-dxf bzty 8))
(setq bili(vla-get-ScaleFactor obj))
;(if(= (vla-get-ObjectName obj) "AcDbRotatedDimension")
(while (setq en(entnext en))
(setq tylx (get-dxf en 0))
(if (wcmatch tylx "*TEXT")
(progn
(setq zg(get-dxf en 40))
(setq pts (lm-getmtextbox1 en 0 (* zg 0.15)))
(entmake (list '(0 . "line")(cons 62 1)(cons 8 "0")(cons 10 (car pts))(cons 11 (cadr pts))))
)
)
)
;)
)
(princ)
)

(defun c:bzl (/ bili crpt en get-dxf lm-getmtextbox1 obj pts ss ss-enlst tc tylx zg) 
        (defun get-dxf(en n) 
                (if (not (listp en)) (setq en (entget en))) 
                (cdr (assoc n en)) 
        ) 
        (defun ss-enlst (ss / enlst) 
                (cond 
                        ((= (type ss) 'PICKSET) 
                                (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS))) 
                        ) 
                        ((= (type ss) 'LIST) 
                                (setq enlst (ssadd)) 
                                (last (mapcar '(lambda (x) (ssadd x enlst)) ss)) 
                        ) 
                ) 
        ) 
        (defun lm-getmtextbox1 (obj offh offs / MXV B ENX H J L M N O P R W) 
                (Defun mxv (m v) 
                        (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m) 
                ) 
                (setq enx (entget obj)) 
                (if (null off) 
                        (setq off 0.0) 
                ) 
                (if 
                        (setq l 
                                (cond 
                                        ((= "TEXT" (cdr (assoc 0 enx))) 
                                                (setq b (cdr (assoc 10 enx)) 
                                                        r (cdr (assoc 50 enx)) 
                                                        l (textbox enx) 
                                                ) 
                                                (list 
                                                        (list (- (caar l) offh) (- (cadar l) offs)) 
                                                        (list (+ (caadr l) offh) (- (cadar l) offs)) 
                                                        (list (+ (caadr l) offh) (+ (cadadr l) offs)) 
                                                        (list (- (caar l) offh) (+ (cadadr l) offs)) 
                                                ) 
                                        ) 
                                        ((= "MTEXT" (cdr (assoc 0 enx))) 
                                                (setq n (cdr (assoc 210 enx)) 
                                                        b (trans (cdr (assoc 10 enx)) 0 n) 
                                                        r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n)) 
                                                        w (cdr (assoc 42 enx)) 
                                                        h (cdr (assoc 43 enx)) 
                                                        j (cdr (assoc 71 enx)) 
                                                        o (list 
                                                                        (cond 
                                                                                ((member j '(2 5 8)) (/ w -2.0)) 
                                                                                ((member j '(3 6 9)) (- w)) 
                                                                                (0.0) 
                                                                        ) 
                                                                        (cond 
                                                                                ((member j '(1 2 3)) (- h)) 
                                                                                ((member j '(4 5 6)) (/ h -2.0)) 
                                                                                (0.0) 
                                                                        ) 
                                                                ) 
                                                ) 
                                                (list 
                                                        (list (- (car o) offh) (- (cadr o) offs)) 
                                                        (list (+ (car o) w offh) (- (cadr o) offs)) 
                                                        (list (+ (car o) w offh) (+ (cadr o) h offs)) 
                                                        (list (- (car o) offh) (+ (cadr o) h offs)) 
                                                ) 
                                        ) 
                                ) 
                        ) 
                        ((lambda (m) 
                                 (mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l) 
                         ) 
                                (list 
                                        (list (cos r) (sin (- r)) 0.0) 
                                        (list (sin r) (cos r) 0.0) 
                                        '(0.0 0.0 1.0) 
                                ) 
                        ) 
                ) 
        ) 
  (princ "\n选择标注集合") 
  (setq ss (ssget '((0 . "DIMENSION")))) 
  (foreach bzty (ss-enlst ss) 
                (setq obj (vlax-ename->vla-object bzty)) 
                (setq en (get-dxf (tblsearch "block" (get-dxf bzty 2)) -2));获得标注的图元名 
                (setq crpt(get-dxf bzty 11)) 
                (setq tc(get-dxf bzty 8)) 
                (setq bili(vla-get-ScaleFactor obj)) 
                ;(if(= (vla-get-ObjectName obj) "AcDbRotatedDimension") 
                (while (setq en(entnext en)) 
                        (setq tylx (get-dxf en 0)) 
                        (if (wcmatch tylx "*TEXT") 
                                (progn 
                                        (setq zg(get-dxf en 40)) 
                                        (setq pts (lm-getmtextbox1 en 0 (* zg 0.15))) 
                                        (entmake (list '(0 . "line")(cons 62 1)(cons 8 "0")(cons 10 (car pts))(cons 11 (cadr pts)))) 
                                ) 
                        ) 
                ) 
                ;) 
        ) 
        (princ) 
)

ferious · 发表于 2024-1-5 19:47:08

飞雪前辈，请问这个标注外框的函数，返回的是？现在想要再标注文字周边划方框，帮忙指导一下

(defun c:ddr (/ bili crpt en get-dxf lm-getmtextbox1 obj pts ss ss-enlst tc tylx zg huajuxing L)
(defun get-dxf(en n)
(if (not (listp en)) (setq en (entget en)))
(cdr (assoc n en))
)
(defun ss-enlst (ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
)
)
(defun lm-getmtextbox1 (obj offh offs / MXV B ENX H J L M N O P R W)
(Defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)
(setq enx (entget obj))
(if (null off)
(setq off 0.0)
)
(if
(setq l
(cond
((= "TEXT" (cdr (assoc 0 enx)))
(setq b (cdr (assoc 10 enx))
r (cdr (assoc 50 enx))
l (textbox enx)
)
(list
(list (- (caar l) offh) (- (cadar l) offs))
(list (+ (caadr l) offh) (- (cadar l) offs))
(list (+ (caadr l) offh) (+ (cadadr l) offs))
(list (- (caar l) offh) (+ (cadadr l) offs))
)
)
((= "MTEXT" (cdr (assoc 0 enx)))
(setq n (cdr (assoc 210 enx))
b (trans (cdr (assoc 10 enx)) 0 n)
r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))
w (cdr (assoc 42 enx))
h (cdr (assoc 43 enx))
j (cdr (assoc 71 enx))
o (list
(cond
((member j '(2 5 8)) (/ w -2.0))
((member j '(3 6 9)) (- w))
(0.0)
)
(cond
((member j '(1 2 3)) (- h))
((member j '(4 5 6)) (/ h -2.0))
(0.0)
)
)
)
(list
(list (- (car o) offh) (- (cadr o) offs))
(list (+ (car o) w offh) (- (cadr o) offs))
(list (+ (car o) w offh) (+ (cadr o) h offs))
(list (- (car o) offh) (+ (cadr o) h offs))
)
)
)
)
((lambda (m)
(mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l)
)
(list
(list (cos r) (sin (- r)) 0.0)
(list (sin r) (cos r) 0.0)
'(0.0 0.0 1.0)
)
)
)
)
(princ "\n选择标注集合")
(setq ss (ssget '((0 . "DIMENSION"))))
(setq oldlayer (getvar "clayer"))
(command "layer" "m" "DGWT-REV" "c" "4" "" "" "")
;(setq bzty (nth 0 (ss-enlst ss)))
(foreach bzty (ss-enlst ss)
(setq obj (vlax-ename->vla-object bzty))
(setq en (get-dxf (tblsearch "block" (get-dxf bzty 2)) -2));获得标注的匿名图元块的文字图元名
(setq crpt(get-dxf bzty 11)) ;标注文字的中点（在 OCS 中）
(setq tc(get-dxf bzty 8))
(setq bili(vla-get-ScaleFactor obj))
;(if(= (vla-get-ObjectName obj) "AcDbRotatedDimension")
(while (setq en(entnext en)) ;一直循环找到该匿名块中成员是文字为止
(setq tylx (get-dxf en 0))
(if (wcmatch tylx "*TEXT")
(progn
(setq zg(get-dxf en 40))
(setq pts (lm-getmtextbox1 en (* zg 0.5) (* zg 0.5)))
;(entmake (list '(0 . "line")(cons 62 240)(cons 10 (car pts))(cons 11 (cadr pts))))
(command "pline" (nth 0 pts) (nth 1 pts) (nth 2 pts) (nth 3 pts) "c" "" "" "" )
(setq huajuxing (entlast) )
(setq L (* 0.3 zg))
(command "offset" (* 0.2 zg) (entlast) (polar (car pts) (* (/ 270.0 180.0 ) 3.1415) (* 0.2 zg) ) "")
;;; 偏移方向根据生成矩形的角点,pt1,pt2定，本程序pt2为右上角点，pt1为左下角点，所以为pt2外围方向
(command "revcloud" "S" "N" "a" L L "o" (entlast) "")
(COMMAND "CHANGE" (entlast) "" "PROPERTIES" "la" "DGWT-REV" "")
(command "_erase" huajuxing "" )
)
)
)
)
(princ)
)

(defun c:ddr (/ bili crpt en get-dxf lm-getmtextbox1 obj pts ss ss-enlst tc tylx zg  huajuxing  L) 
        (defun get-dxf(en n) 
                (if (not (listp en)) (setq en (entget en))) 
                (cdr (assoc n en)) 
        ) 
        (defun ss-enlst (ss / enlst) 
                (cond 
                        ((= (type ss) 'PICKSET) 
                                (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS))) 
                        ) 
                        ((= (type ss) 'LIST) 
                                (setq enlst (ssadd)) 
                                (last (mapcar '(lambda (x) (ssadd x enlst)) ss)) 
                        ) 
                ) 
        ) 
        (defun lm-getmtextbox1 (obj offh offs / MXV B ENX H J L M N O P R W) 
                (Defun mxv (m v) 
                        (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m) 
                ) 
                (setq enx (entget obj)) 
                (if (null off) 
                        (setq off 0.0) 
                ) 
                (if 
                        (setq l 
                                (cond 
                                        ((= "TEXT" (cdr (assoc 0 enx))) 
                                                (setq b (cdr (assoc 10 enx)) 
                                                        r (cdr (assoc 50 enx)) 
                                                        l (textbox enx) 
                                                ) 
                                                (list 
                                                        (list (- (caar l) offh) (- (cadar l) offs)) 
                                                        (list (+ (caadr l) offh) (- (cadar l) offs)) 
                                                        (list (+ (caadr l) offh) (+ (cadadr l) offs)) 
                                                        (list (- (caar l) offh) (+ (cadadr l) offs)) 
                                                ) 
                                        ) 
                                        ((= "MTEXT" (cdr (assoc 0 enx))) 
                                                (setq n (cdr (assoc 210 enx)) 
                                                        b (trans (cdr (assoc 10 enx)) 0 n) 
                                                        r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n)) 
                                                        w (cdr (assoc 42 enx)) 
                                                        h (cdr (assoc 43 enx)) 
                                                        j (cdr (assoc 71 enx)) 
                                                        o (list 
                                                                        (cond 
                                                                                ((member j '(2 5 8)) (/ w -2.0)) 
                                                                                ((member j '(3 6 9)) (- w)) 
                                                                                (0.0) 
                                                                        ) 
                                                                        (cond 
                                                                                ((member j '(1 2 3)) (- h)) 
                                                                                ((member j '(4 5 6)) (/ h -2.0)) 
                                                                                (0.0) 
                                                                        ) 
                                                                ) 
                                                ) 
                                                (list 
                                                        (list (- (car o) offh) (- (cadr o) offs)) 
                                                        (list (+ (car o) w offh) (- (cadr o) offs)) 
                                                        (list (+ (car o) w offh) (+ (cadr o) h offs)) 
                                                        (list (- (car o) offh) (+ (cadr o) h offs)) 
                                                ) 
                                        ) 
                                ) 
                        ) 
                        ((lambda (m) 
                                 (mapcar '(lambda (p) (mapcar '+ (mxv m p) b)) l) 
                         ) 
                                (list 
                                        (list (cos r) (sin (- r)) 0.0) 
                                        (list (sin r) (cos r) 0.0) 
                                        '(0.0 0.0 1.0) 
                                ) 
                        ) 
                ) 
        ) 
  (princ "\n选择标注集合") 
  (setq ss (ssget '((0 . "DIMENSION")))) 
(setq oldlayer (getvar "clayer")) 
   (command "layer"   "m"   "DGWT-REV"     "c" "4" ""    ""    "") 
  ;(setq bzty (nth 0 (ss-enlst ss))) 
  (foreach bzty (ss-enlst ss) 
                (setq obj (vlax-ename->vla-object bzty)) 
                (setq en (get-dxf (tblsearch "block" (get-dxf bzty 2)) -2));获得标注的匿名图元块的文字图元名 
                (setq crpt(get-dxf bzty 11))  ;标注文字的中点（在 OCS 中） 
                (setq tc(get-dxf bzty 8)) 
                (setq bili(vla-get-ScaleFactor obj)) 
                ;(if(= (vla-get-ObjectName obj) "AcDbRotatedDimension") 
 
    
                (while (setq en(entnext en))  ;一直循环找到该匿名块中成员是文字为止 
                        (setq tylx (get-dxf en 0)) 
 
       
                        (if (wcmatch tylx "*TEXT") 
                                (progn 
                                        (setq zg(get-dxf en 40)) 
                                        (setq pts (lm-getmtextbox1 en (* zg 0.5)  (* zg 0.5))) 
 
                                       ;(entmake (list '(0 . "line")(cons 62 240)(cons 10 (car pts))(cons 11 (cadr pts)))) 
                    (command "pline"   (nth 0 pts)   (nth 1 pts)   (nth 2 pts)   (nth 3 pts)  "c"    ""   ""  "" ) 
          (setq huajuxing   (entlast) ) 
                    (setq L (*  0.3 zg)) 
          (command "offset"   (* 0.2 zg)     (entlast)   (polar (car pts)   (* (/ 270.0 180.0 ) 3.1415)    (* 0.2 zg)    )   "") 
   ;;;  偏移方向根据生成矩形的角点,pt1,pt2定，本程序pt2为右上角点，pt1为左下角点，所以为pt2外围方向 
                       (command "revcloud"  "S" "N" "a" L L "o" (entlast) "") 
                                         (COMMAND "CHANGE"  (entlast)  "" "PROPERTIES" "la" "DGWT-REV"      "") 
                                          (command "_erase"  huajuxing "" ) 
 
                                ) 
         
                        ) 
 
       
                ) 
                
        ) 
        (princ) 
)

飞雪神光 · 发表于 2023-11-12 09:09:35

是在下边呢

ferious · 发表于 2023-11-12 10:17:32

我的是这样的效果，不知为何y方向未有赋值还是？
能否指出我的错误？看了好久不知哪里错了

ferious · 发表于 2024-1-5 22:21:58

飞雪神光发表于 2024-1-5 20:24

飞雪前辈，这里看着比较蒙，能否指点一下返回值是什么？

飞雪神光 · 发表于 2024-1-5 22:38:13

(set 'co 1) = (setq co 1)注意set的变量是有个 ' 的
单行多行返回值是一样的标注中的文字就是多行的

ferious · 发表于 2024-1-5 22:40:10

飞雪神光发表于 2024-1-5 22:38
(set 'co 1) = (setq co 1)注意set的变量是有个 ' 的
单行多行返回值是一样的标注中的文字就是多行的

是的，我i昂知道是返回四个点的坐标吗？为何多行还要再次处理？

飞雪神光 · 发表于 2024-1-5 22:58:28

并没有再次处理就是求得多行文字的包围框

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

大师求助，为何直线没有在标注下，而是在标注线上？

评分

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源