求一个标注能断开的代码

xj6019

start4444 发表于 2020-10-30 23:14
其实很简单，一般选对象都是想提取对象图元名，entsel是单选个体，ssget是选集，选集的话要多一步提取个 ...

再请教一下centsel这个函数是不是不能按照你这个法改呀
我直接用你的那个套上
(setq ent(ssname (ssget ":S" '((0 . "DIMENSION"))) 0))
和套到我手里的那个代码上
(or(setq ent(ssname(ssget "i"'((0 . "DIMENSION")))0)) (and(princ "\n選擇要拆分的尺寸")(setq ent(ssname(ssget ":S" '((0 . "DIMENSION")))0))))

这两种方式都不行呢，你再帮我看一下行吗，看看应该怎么改呀。
我把那个DDR等分代码，贴到下面，见下一楼，你整体看一下，那个代码也是你以前帮我改的。
看看怎么也改成可以先选择，再执行，这样我把几个代码再组合起来就完美了，

xj6019

start4444 发表于 2020-10-30 23:14
其实很简单，一般选对象都是想提取对象图元名，entsel是单选个体，ssget是选集，选集的话要多一步提取个 ...

这个是整体的代码，麻烦你再帮我看看，谢谢了。
(vl-load-com)
(defun c:ddr (/ n x ent entL p2 p3 px1 px2 py1 py2 ptdd xl sa pt0 ppt ptdd)
(command "Selectioncycling" "0");ctrl/w關閉
        (setvar "cmdecho" 0)
        (command "undo" "be")
        (setq entL '())
        (while
                (if
                ;(setq ent (centsel "\n>>>選擇要拆分的尺寸 或 <按 ESC 退出>:" "DIMENSION")) 这个是原始可用的
        (setq ent(ssname (ssget ":S" '((0 . "DIMENSION"))) 0))   这样改了不行       
        (or(setq ent(ssname(ssget "i"'((0 . "DIMENSION")))0)) (and(princ "\n選擇要拆分的尺寸")(setq ent(ssname(ssget ":S" '((0 . "DIMENSION")))0))))        这样改了也不行
                        (progn
                                (setq x (entget ent)
                                        entL (cons ent entL)
          p2 (dxfxj 13 x)
          p3 (dxfxj 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 (dxfxj -2 (tblsearch "block" (dxfxj 2 x))))
          SA (abs (sin (angle (dxfxj 10 xl) (dxfxj 11 xl)))))
                                (while (setq pt0 (getpoint "\n>>>左鍵点取拆分点 或 <右鍵選擇其他尺寸>:"))
                                        (command ".copy" ent "" "0,0" "@")
                                        (setq entL (cons (entlast) entL))
                                        (cond
                                                ((equal SA 1 1e-6) ;;水平
                                                        (setq ptdd (cons pt0 ptdd)
                                                                ppt (Lsort ptdd 0))
                                                )
                                                ((equal SA 0 1e-6) ;;垂直
                                                        (setq ptdd (cons pt0 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)                                                                                       
                                        )
                                ))
                        (princ "\n退出")
                ))
  (command "undo" "e" ) (setvar "cmdecho" 1 )
  (princ)
)

start4444

ssget要放最前面才能先选对象

xj6019

start4444 发表于 2020-10-31 18:57
ssget要放最前面才能先选对象

完美，漂亮，又完美解决了一个愿望，非常感谢！！