[源码]标注文本修改、线性比例、标注断开、标注合并 --待完善

yxp

动态修改全局比例、标注断开连续[源码] http://bbs.mjtd.com/thread-102226-1-1.html

---

.

如何快速修改某个标注的线性比例？用属性窗口修改有点慢。

比如将标注长度为500的尺寸修改为1000，但需要和原图形长度仍然关联，故不能修改标注文本，只能把线性比例乘2。（注：不是全局比例或全局线性比例）

关于快速批量修改某个标注文本的程序如下，希望能抛砖引玉。

(defun c:dde (/ ss txt)
 (setvar "cmdecho" 0)   (princ "\n 选择需修改文本的标注:")
 (setq ss (ssget))
(if ss (progn (princ "\n 请输入字符（空格＝恢复）<\"")(princ txt_de)
 (setq txt (getstring T "\">:"))
(cond ((= txt " ")(setq txt ""))
 ((= txt "")(setq txt txt_de))
 (T (setq txt_de txt))
)(command "dimedit" "n" txt "p" "")
))(princ)
)

yxp

好的，希望你的程序完成了后能体现一下源码共享精神，记住来自明经、回到明经。

这些小程序其实谁都能编写，无外乎花些时间而已，若每个人都将自己的成果藏着掖着，其实是一种最大的社会浪费。

zhangrunze

hnfsf 发表于 2009-8-29 01:52
标注合并；；(defun c:21( / d13 d14 dxf dxfn e1 e2 n p13 p14 plst ss)&nbsp; (command "ucs" "w")&nbsp; ...

感谢分享~
要是能鼠标动态点击指定标注距离就好了~

ligaoshenga1

yxp 发表于 2009-8-14 09:25
本帖最后由 作者 于 2009-8-14 11:41:27 编辑  

;;如你所愿，稍微修改了一下程序，可以连续进行断开了， ...

大佬很牛逼

AMTONNY

;;修改标注比例
(DEFUN C:bzz ()
  (SETVAR "CMDECHO" 0)
  ;(PRINC "\nSelect Dimension(s) :")
  (PRINC "\n修改标注比例 :")
  (IF (SETQ SS (SSGET '((0 . "DIMENSION"))))
  (PROGN(SETQ N (GETDIST "\n请输入新比例 :")
  OLDFAC (GETVAR "DIMLFAC"))
   (SETVAR "DIMLFAC" N)
   (COMMAND "DIMSTYLE" "_APPLY" SS "")
   (SETVAR "DIMLFAC" OLDFAC)
  ))
  (SETVAR "CMDECHO" 1)
  (PRINC)
)

yxp

非常感谢！AMTONNY

yxp

以下是刚弄好的标注断开程序，继续抛砖引玉，求标注合并程序，最好用autolisp完成。

(defun c:ddr (/ ent ent1 pt0 pt1 pt2)
 (setvar "cmdecho" 0)
 (command "undo" "be")
  (if (setq ent (car (entsel "\n 选择要断开的标注<退出>:")))
    (if (= (cdr (assoc 0 (entget ent))) "DIMENSION")
      (progn
         (redraw ent 3)(setq pt0 (getpoint "\n 点取断开点:"))(redraw ent 4)
         (command "copy" ent "" '(1 1) "@") (setq ent1 (entlast))
         (setq pt1 (cdr (assoc 13 (entget ent)))  ;;原标注起止点
               pt2 (cdr (assoc 14 (entget ent))))
         (setq pt0 (inters pt0 (polar pt0 (+ (angle pt1 pt2) (/ pi 2)) 1.0) pt1 pt2 nil))
         (entmod (subst (cons 13 pt0) (assoc 13 (entget ent))(entget ent)))
         (entmod (subst (cons 14 pt0) (assoc 14 (entget ent1))(entget ent1)))
      )(princ "\n 无效的标注"))
  )(command "undo" "e")(princ)
)

5061220

谢谢收藏了，有空我用OpenDCL工具进行一下改编，加个对话框界面，更好用哦，嘿嘿！

5061220

向楼主学习，我现在学OPenDCL对话框编辑工具。比CAD自带的DCL
好用多了。

学Lisp才半年，只是个菜鸟。自编了一些小程序，可太肤浅，所以很少在论坛里发表。

其实是各位大侠的程序编的太好了，拿不出手。

等以后有了好程度一定拿出来和大家共享。

yxp

经过测试，4楼的程序 当选取点断开点出现在标注之外时 会出现bug，现作出如下小改动。其实改动后这个程序的功能已经超出“标注断开”的定义了，即如果断开点位于标注之外，则实现“连续标注”的功能。

;;by: yxp，明经通道，2009年8月11日

(defun c:ddr (/ ent ent1 pt0 pt1 pt2 ppp);;
 (setvar "cmdecho" 0)
 (command "undo" "be")
  (if (setq ent (car (entsel "\n 选择要断开的标注<退出>:")))
    (if (= (cdr (assoc 0 (entget ent))) "DIMENSION")
      (progn
         (redraw ent 3)(setq pt0 (getpoint "\n 点取断开点:"))(redraw ent 4)
         (if pt0 (progn
         (command "copy" ent "" '(1 1) "@")
         (setq ent1 (entlast))
         (setq pt1 (cdr (assoc 13 (entget ent)))  ;;原标注起止点
               pt2 (cdr (assoc 14 (entget ent))))
         (setq pt0 (inters pt0 (polar pt0 (+ (angle pt1 pt2) (/ pi 2)) 1.0) pt1 pt2 nil))
         (setq ppp (maxL pt1 pt2 pt0) pt0 (car ppp) pt1 (cadr ppp) pt2 (caddr ppp))
         (dmup 13 pt0 ent)(dmup 14 pt1 ent)(dmup 13 pt1 ent1)(dmup 14 pt2 ent1)
      )(princ " 未拾取断点，程序取消")))(princ "\n 无效的标注样式，程序取消"))
  )(command "undo" "e")(princ)
)
(defun maxL(p1 p2 p3 / pt A1 A2 A3)
 (setq A1 (distance p1 p2)
       A2 (distance p2 p3)
       A3 (distance p1 p3))
 (if (= A1 (max A1 A2 A3)) (setq pt p2 p2 p3 p3 pt))
 (if (= A2 (max A1 A2 A3)) (setq pt p2 p2 p1 p1 pt))
 (list p1 p2 p3))
(defun dmup(n pt en)(entmod (subst (cons n pt) (assoc n (entget en))(entget en))))

hnfsf

再优化一下做成能够连续断开就更棒了，帮顶一个！

yxp

hnfsf发表于2009-8-14 2:06:00再优化一下做成能够连续断开就更棒了，帮顶一个！

;;如你所愿，稍微修改了一下程序，可以连续进行断开了，但是
;;在连续断开对齐标注时有一个巨大的bug，请教论坛各位高手
;;bug或限制：
;;1. 线性标注: 标注点必须是竖直或水平的，否则将会导致断开点不准确；
;;2. 对齐标注：必须从右往左进行连接，当从左往右连接对齐标注时，标注尺寸的引出长度比原来的要短。

(defun c:ddr (/ ent pt0 pt1 pt2 pt3 ppp ny pDDr entL);;
 (setvar "cmdecho" 0)
 (command "undo" "be")
  (if (setq ent (car (entsel "\n 选择要断开或连续的标注<退出>:")))
    (if (= (cdr (assoc 0 (entget ent))) "DIMENSION")(progn
         (setq pt1 (cdr (assoc 13 (entget ent)))
               pt2 (cdr (assoc 14 (entget ent)))
               plt (list pt1 pt2)
               entL(cons ent entL))
         (redraw ent 3)(setq pt0 (getpoint "\n 拾取断开或连续点<退出>:"))(redraw ent 4)
         (while pt0 (progn
         (command "copy" ent "" '(1 1) "@")
         (setq entL (cons (entlast) entL)
          pt3 (inters pt0 (polar pt0 (+ (angle pt1 pt2) (/ pi 2.0)) 1.0) pt1 pt2 nil)
          pDDr (DDR-insert-Lt plt pt3) ny 0)
           (repeat (length pDDr)
           (DDR-dmup 13 (car (nth ny pDDr)) (nth ny entL))
           (DDR-dmup 14 (cadr (nth ny pDDr)) (nth ny entL))
           (setq ny (+ ny 1)))(setq plt (cons pt3 plt)))
           (setq pt0 (getpoint "\n 拾取断开或连续点<退出>:"))))
      (princ "\n 无效的标注"))
  )(command "undo" "e") (setvar "cmdecho" 1)(princ)
)
(defun DDR-insert-Lt(plt pot / n xplt ta)
(setq plt (cons pot plt)
 Ta (vl-sort plt (function (lambda (e1 e2)(< (cadr e1) (cadr e2)))))
 plt (vl-sort ta (function (lambda (e1 e2)(< (car e1) (car e2))))) n 0 xplt '())
(repeat (- (length plt) 1)
 (setq xplt (cons (list (nth n plt) (nth (setq n (+ n 1)) plt)) xplt)))(reverse xplt)
)
(defun vl_sort (lst fun / k nlst lst2)
  (foreach n lst(setq k T lst2 (apply 'append (mapcar '(lambda (x)(if (and K ((eval fun) n x))
  (progn (setq k nil) (list n x)) (list x))) nlst)) nlst (if K (append lst2 (list n)) lst2))))
(defun DDR-dmup(n pt en)(entmod (subst (cons n pt) (assoc n (entget en))(entget en))))