标注打断源码,但不支持UCS

hooboxu

;;标注打断+连续标注
(vl-load-com)
(defun c:ddr (/ n x ent entl p2 p3 px1 px2 py1 py2 ptdd xl sa pt0 ppt ptdd)
  (setvar "cmdecho" 0)

  (if (setq ent (centsel "\n选择标注 或 <退出>:" "DIMENSION"))
    (progn
      (setq x         (entget ent)
            entl (cons ent entl)
            p2         (dxf 13 x)
            p3         (dxf 14 x)
            px1         (list (car p2) (/ (+ (cadr p2) (cadr p3)) 2.0))
            px2         (list (car p3) (/ (+ (cadr p2) (cadr p3)) 2.0))
            py1         (list (/ (+ (car p2) (car p3)) 2.0) (cadr p2))
            py2         (list (/ (+ (car p2) (car p3)) 2.0) (cadr p3))
            ptdd (list p2 p3)
            xl         (entget (dxf -2 (tblsearch "block" (dxf 2 x))))
            sa         (abs (sin (angle (dxf 10 xl) (dxf 11 xl))))
      )

      (while (setq pt0 (getpoint "\n取点 或 <退出>:"))
        (command "undo" "be")

        (command ".copy" ent "" "0,0" "@")
        (setq entl (cons (entlast) entl))
        (cond
          ((equal sa 1 1e-6)
           ;;水平
           (setq ptdd (cons (ptper pt0 px1 px2) ptdd)
                 ppt  (lsort ptdd 0)
           )
          )
          ((equal sa 0 1e-6)
           ;;垂直
           (setq ptdd (cons (ptper pt0 py1 py2) ptdd)
                 ppt  (lsort ptdd 1)
           )
          )
          (t
           (setq ptdd (cons (ptper pt0 p2 p3) ptdd)
                 ppt  (lsort ptdd 2)
           )
          )
        )
        (setq ppl (mapcar 'list ppt (cdr ppt))
              n          0
        )
        (repeat        (length ppl)
          (setq        xf  (entget (nth n entl))
                nxf (subst (cons 13 (car (nth n ppl))) (assoc 13 xf) xf)
                wxf (subst (cons 14 (cadr (nth n ppl))) (assoc 14 nxf) nxf)
                n   (1+ n)
          )
          (entmod wxf)
        )

        (command "undo" "e")
      )
    )

    (princ "\n退出")
  )

  (setvar "cmdecho" 1)

  (princ)
)

(defun centsel (msg f / ent ss)
  (princ msg)
  (while (null ent)
    (setq ss (ssget  (list (cons 0 f))))
    (if        ss
      (setq ent (ssname ss 0))
    )
  )
  (redraw ent 3)
  ent
)
;;取值dxf
(defun dxf (x e) (cdr (assoc x e)))
;;求垂足
(defun ptper (pt0 pt1 pt2)
  (inters pt0 (polar pt0 (+ (angle pt1 pt2) (/ pi 2)) 1.0) pt1 pt2 nil)
)
;;排序 0 水平 1 垂直 2 倾斜
(defun lsort (lt i)
  (cond
    ((or (= i 0) (= i 2)) (setq lt (vl-sort lt (function (lambda (e1 e2) (< (car e1) (car e2)))))))
    ((or (= i 1) (= i 2))
     (setq lt (vl-sort lt (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))))
    )
  )
)

(princ)

hooboxu

加了
(command "ucs" "w")
(command "ucs" "")
有的时候也要出问题.

鱼与熊掌

这么厉害.
标注打断.

2. (defun c:cxdd2(/ en lind_db n p10 p13 p14 ptlst pts ss_line)
   
3.         (setq en (dx))
   
4.         (setq p13 (cx-dxf  13 en)
   
5.                 p14 (cx-dxf  14 en)
   
6.                 p10 (cx-dxf  10 en)
   
7.                 ptlst(get-box en)
   
8.                 ss_line(ssget "c"(car ptlst)(cadr ptlst)'((0 . "LINE")))
   
9.         )
   
10.         (foreach x (cx-ss2en ss_line)
    
11.                 (setq lind_db (cx-db x))
    
12.                 (setq pts (cons (inters p13 p14 (car lind_db)(cadr lind_db)t)pts))
    
13.         )
    
14.         (setq pts (append(list p13 p14)pts))
    
15.         (setq pts(cx-sort pts "xy" 0.01))
    
16.         (entdel en)
    
17.         (repeat (setq n(1-(length pts)))
    
18.                 (cx-mak-dim (nth n pts)(nth (1- n) pts)p10)
    
19.                 (setq n (1- n))
    
20.         )
    
21. )

(defun c:cxdd2(/ en lind_db n p10 p13 p14 ptlst pts ss_line)<br />         (setq en (dx))<br />         (setq p13 (cx-dxf  13 en)<br />                 p14 (cx-dxf  14 en)<br />                 p10 (cx-dxf  10 en)<br />                 ptlst(get-box en)<br />                 ss_line(ssget "c"(car ptlst)(cadr ptlst)'((0 . "LINE")))<br />         )<br />         (foreach x (cx-ss2en ss_line)<br />                 (setq lind_db (cx-db x))<br />                 (setq pts (cons (inters p13 p14 (car lind_db)(cadr lind_db)t)pts))<br />         )<br />         (setq pts (append(list p13 p14)pts))<br />         (setq pts(cx-sort pts "xy" 0.01))<br />         (entdel en)<br />         (repeat (setq n(1-(length pts)))<br />                 (cx-mak-dim (nth n pts)(nth (1- n) pts)p10)<br />                 (setq n (1- n))<br />         )<br /> )

鱼与熊掌

鱼与熊掌 发表于 2015-1-16 12:42
这么厉害.
标注打断.

记得加载我的库

Leolaputa

我滴哥啊，我看不明白你的subst到底替换了什么东西为什么可以一个标注变俩，能说说吗。