[分享]尺寸合并，分解

lzy9788

提供一个尺寸合并、分解的源程序，请各位指点意见…… 在使用中会出现问题吗? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;尺寸合并 2004年4月;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:ccb ()
(setvar "cmdecho" 0)
(command "_.undo" "be")
(princ "\n尺寸合并<<ver 1.0--by Rokin...>>.请选择要合并的尺寸:")
(setq ss1 (ssget ":s" '((0 . "DIMENSION"))))
(setq nam1 (ssname ss1 0)
ent1 (entget nam1)
pdim1_13 (cdr (assoc 13 ent1))
pdim1_14 (cdr (assoc 14 ent1)))
(setq ss2 (ssget ":s" '((0 . "DIMENSION"))))
(setq nam2 (ssname ss2 0)
ent2 (entget nam2)
pdim2_13 (cdr (assoc 13 ent2))
pdim2_14 (cdr (assoc 14 ent2)))
(vl-load-com)
(setq bb (list pdim1_13 pdim1_14 pdim2_13 pdim2_14)) (setq bb1
(vl-sort bb
(function (lambda (e1 e2)
(< (car e1) (car e2)) ) ) )
);;end setq X坐标从小到大排序 (setq bb2
(vl-sort bb
(function (lambda (e1 e2)
(< (cadr e1) (cadr e2)) ) ) )
);;end setq Y坐标从小到大排序 (setq ang1 (angle pdim1_13 pdim1_14)) (setq bbb (cond ((= ang1 0) bb1)
((= ang1 pi) bb1)
((/= ang1 0) bb2)
((/= ang1 pi) bb2))) ;(setq ang2 (angle (nth 0 bbb) (nth 1 bbb))
; ang3 (angle (nth 0 bbb) (nth 3 bbb))) ;(if (/= ang2 ang3)
; (princ "\n不在同一直线，尺寸不能合并!")
; (progn
(setq ent1 (subst (cons 13 (nth 0 bbb)) (assoc 13 ent1) ent1))
(setq ent1 (subst (cons 14 (nth 3 bbb)) (assoc 14 ent1) ent1))
(entmod ent1)
(command "erase" ss2 "")
; );end progn
;;);end if
(command "_.undo" "e")
(setvar "cmdecho" 1)
(princ));end defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;尺寸分解 2004年4月;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ccf ()
(setvar "cmdecho" 0)
(command "_.undo" "be")
(princ "\n尺寸一分为二<<ver 1.0--by Rokin...>>.\n请选择要分解的尺寸:")
(setq ss1 (ssget ":s" '((0 . "DIMENSION"))))
(setq point (getpoint "\n请点取分解点位置:")) (setq nam1 (ssname ss1 0)
ent1 (entget nam1)
pdim1_13 (cdr (assoc 13 ent1))
pdim1_14 (cdr (assoc 14 ent1))) (command "copy" ss1 "回复

使用道具 举报

• 置顶卡
• 变色卡
• 显身卡

wyj_007

这个功能在天正里的尺寸工具栏里有了。

无痕

ｃｃｂ好些，但也有不听话的时候


ｃｃｆ错误多些，经常有


错误: DXF 组不正确: (14)


错误: DXF 组不正确: (1３)


非ｗｃｓ下，ｃｃｆ几乎不能用，ｃｃｄ有的合并后没有删除原标注

ljcgq

;=====================================
; 水平尺寸线分割标注
;=====================================
(defun c:fg( /)
(print "请选择要分割的尺寸线:")
(setq ss (ssget '(( 0 . "DIMENSION" )) ))
(command "point" (cdr (assoc 13 (entget (ssname ss 0 )))) )
(setq ss1 (ssadd (entlast) ss1 ))
(command "point" (cdr (assoc 14 (entget (ssname ss 0 )))) )
(setq ss1 (ssadd (entlast) ss1))
(command "point" (getpoint "请选择分割点:" ) )
(setq ss1 (ssadd (entlast) ss1) )
(setq os (getvar "osmode") )
(command "qdim" ss1 "" (cdr (assoc 10 (entget (ssname ss 0 )))) )
(command "erase" ss1 "" ) (command "erase" ss "" )
(setvar "osmode" os)
)

ljcgq

以上程序需要修改，麻烦帮我看一下。

无痕

ljcgq，照片里面是你还是你老婆孩子？

无痕

不过，对倾斜的标注，这个算法还是有问题的 (defun c:fg( /)
(print "请选择要分割的尺寸线:")
(setq ss (ssget ":s" '(( 0 . "DIMENSION" )) )
ss1 (ssadd));!!!!!
(command "point" (cdr (assoc 13 (entget (ssname ss 0 )))) )
(setq ss1 (ssadd (entlast) ss1 ))
(command "point" (cdr (assoc 14 (entget (ssname ss 0 )))) )
(setq ss1 (ssadd (entlast) ss1))
(command "point" (getpoint "请选择分割点:" ) )
(setq ss1 (ssadd (entlast) ss1) )
(setq os (getvar "osmode") )
(command "qdim" ss1 "" (cdr (assoc 10 (entget (ssname ss 0 )))) )
(command "erase" ss1 "" ) (command "erase" ss "" )
(setvar "osmode" os)
)

ljcgq

是的，我只是有一个思路，哈哈写了个，没时间在扩展，也许加入ucs转变可以达到斜尺寸的分割，，，大家完善吧。。先谢谢了。。

无痕

哈哈？嘉兴哈哈？

lzy9788

我也有时遇到这样的问题，但代码没什么错啊，我本来想加个限制的，只能合并同一直线上的尺寸，可是加了不能用。有些怪，可能程序本身有些不完全吧


不过我那个对于倾斜的尺寸可以用。