批量修改标注伸出的距离lisp改进

wxa123wl

我这有个lsp可是实现图片中的批量从A变为B的效果，，，可是我现在又希望他可以批量冲C变为D效果，我自己改了好久都没有成功，望大神帮助，不慎感激！

wxa123wl

;;标注距离框选改变bzjl
(defun c:BZJL ( / dist i p10 p11 p13 p14 po po1 poo s1 ss)
  (setq x-xgbzgd(xx-dist "距离" x-xgbzgd 500))
  (setq ss (ssget '((0 . "dimension"))))
  (setq i (sslength ss))
  (while (setq s1 (ssname ss (setq i (1- i))))
    (setq p13 (xx-get-dxf 13 s1)
          p14 (xx-get-dxf 14 s1)
          p10 (xx-get-dxf 10 s1)
          p11 (xx-get-dxf 11 s1)
    )
    (setq po (xx-p-p2l-foot-p p10 p13 p14))
    (setq dist (- (distance po p10) x-xgbzgd))
    (setq poo (polar po (angle po p10) x-xgbzgd))
    (setq po1 (polar p11 (angle p10 po) dist))
    (xx-put-dxf s1 10 poo)
    (xx-put-dxf s1 11 po1)
  )
)

(defun xx-dist (msg def chushi / inp)
  (if (= def nil) (setq def chushi))
  (setq msg (strcat "\n->请确定" msg "(或直接点两点量取) <" (rtos def) ">:"))
  (setq inp(getdist msg))
  (if inp inp def)
)


;找垂足点
(defun xx-p-P2L-Foot-p (pt p1 p2 / xx-mat-Rot90)
(defun xx-mat-Rot90 (vec)
  (vl-list* (- (cadr vec)) (car vec) (cddr vec))
)
  (inters pt (mapcar '+ pt (xx-mat-Rot90 (mapcar '- p1 p2))) p1 p2 nil)
)
(defun xx-put-dxf (ss code new / ent i s1 tp)
    (setq tp (type ss))
  (cond
    ((= tp 'ENAME);判断是否是图元
       (setq ent (entget ss))
     (if (and (= (type code) 'list) (= (type new) 'list));判断是否是表
       (mapcar (function (lambda (x y) (xx-put-dxf ss x y))) code new);表循环取得每个表值，并替换更新
      (progn
        (if (= (xx-get-dxf code ss) nil);为空时
          (entmod (append ent (list (cons code new))));替换为原来的（不变）
          (entmod (subst (cons code new) (assoc code ent) ent));替换成新的对象
        )
       (entupd ss);更新对象
      )
     )
    )
   ((= tp 'PICKSET);判断是否是选择集
      (setq i -1)
    (while (setq s1 (ssname ss (setq i (1+ i))))
       (xx-put-dxf s1 code new)
    )
   )
   ((= tp 'list);判断是否是表
    (foreach x ss (xx-put-dxf x code new));循环递归到更新
   )
   (t (princ "\n xx-put-dxf  错了！"))
  )
ss
)

(defun xx-get-dxf (code s1 / ent lst)
  (if (= (type code) 'list);判断是否是表
    (progn
      (setq ent(entget s1);提取串列
            lst '();设表为空
      )
      (foreach a code ;利用foreach函数循环提取表中各值
        (setq lst (cons (list a (cdr(assoc a ent))) lst));表中串列以后循环加入表
      )
      (reverse lst);将表的元素顺序倒置后返回
    )
    (if (= code -3)  
      (cdr(assoc code (entget s1 '("*"))));提取扩展数据
      (cdr(assoc code (entget s1)))
    )
   )
)

meja

楼上的你考虑线性标注和对齐标注了么？还有坐标系了没有？

guankuiwu

a -b  c-d区别在哪我没看出来啊

Bao_lai

线长一样，一个起点不动，一个终点不动。

guankuiwu

Bao_lai 发表于 2021-3-17 18:24
线长一样，一个起点不动，一个终点不动。

多谢，你这么一说才发现