标注打断源码,但不支持UCS
;;标注打断+连续标注(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)
加了
(command "ucs" "w")
(command "ucs" "P")
有的时候也要出问题. 这么厉害.
标注打断.(defun c:cxdd2(/ en lind_db n p10 p13 p14 ptlst pts ss_line)
(setq en (dx))
(setq p13 (cx-dxf13 en)
p14 (cx-dxf14 en)
p10 (cx-dxf10 en)
ptlst(get-box en)
ss_line(ssget "c"(car ptlst)(cadr ptlst)'((0 . "LINE")))
)
(foreach x (cx-ss2en ss_line)
(setq lind_db (cx-db x))
(setq pts (cons (inters p13 p14 (car lind_db)(cadr lind_db)t)pts))
)
(setq pts (append(list p13 p14)pts))
(setq pts(cx-sort pts "xy" 0.01))
(entdel en)
(repeat (setq n(1-(length pts)))
(cx-mak-dim (nth n pts)(nth (1- n) pts)p10)
(setq n (1- n))
)
) 鱼与熊掌 发表于 2015-1-16 12:42 static/image/common/back.gif
这么厉害.
标注打断.
记得加载我的库 我滴哥啊，我看不明白你的subst到底替换了什么东西为什么可以一个标注变俩，能说说吗。
页:
[1]