一个选择问题

行雲

   (setq sss (ssget) ss (entlast)) ；；选择并二次预选
   (command "explode" sss "") ；；这里能动作
   (setq ss (entnext ss) ；；二次选（这里开始有问题，不动作）
         pt (getpoint "\n坐标原点: ")
         ent (ssname ss 0)；；二次选集循环起点
         i 0
   )

newer

(entnext ss) 得到的是实体名
...
ent (ssname ss 0) ; 这个地方肯定不行了，ss实体名不是旋转集

行雲

newer 发表于 2016-12-23 17:39

原程序是这样的
   (setq ss (ssget)
         pt (getpoint "\n坐标原点: ")
          ent (ssname ss 0)
         i 0
    )
想在 (setq ss (ssget)之后，在ent (ssname ss 0)之前，将ss炸开，然后ent将炸开后的图元接着往下做事。
版主大人帮我改改好不？

newer

entnext  搜索论坛，多看看论坛以前的代码

行雲

newer 发表于 2016-12-23 18:04

好像不该用entnext 了吧，对不？

(setq ss (这里用什么好呀？ ss)
         pt (getpoint "\n坐标原点: ")
          ent (ssname ss 0)
         i 0
    )

看了好多，不得要领，版主将就改改好不

newer

行雲 发表于 2016-12-23 19:23

要说，就详细说下你的程序想要做什么，而不是把局部代码引导要帮你的人走入歧途，你需要客观的描述问题，不要带你的想法。

从你描述的，想不到你接下来要做什么，为什么做。

如果你就想获得炸开后的新实体，那么就一直entnext. 但是炸开不一定是解决你问题的好答案。

行雲

newer 发表于 2016-12-23 19:28

你好，帮我看看
(defun C:zdb (/ dimt dimTad err txtSize s)
     (setvar "cmdecho" 0)
  (command "UNDO" "BE")
  (setq dimt (getvar "DIMTMOVE")
dimTad (getvar "DIMTAD")
txtSize (getvar "TEXTSIZE")
s (getvar "DIMSCALE")
  )
  (if (= s 0.0)
    (setq s 1.0)
  )
  (setvar "DIMTMOVE" 0)
  (setvar "DIMTAD" 0)
  (setvar "TEXTSIZE" (* s (getvar "DIMTXT")))
  (setq err (vl-catch-all-apply 'ac-autoDim nil))
  (if (vl-catch-all-error-p err)
    (progn
      ;; add some error handles here
    )
  )
  (setvar "DIMTMOVE" dimt)
  (setvar "DIMTAD" dimTad)
  (setvar "TEXTSIZE" txtSize)
  (command "UNDO" "E")
(princ))

;;;
;;; global variables: dd, posRec, stPos
;;; main function
(defun ac-autoDim(/ ss ent i inf pt-pairs xs ys x1 x2 y1 y2 xinfs yinfs sub-xinfs sub-yinfs xinf2 yinf2 cpt gap
    dd posRec sEnt sEnts cirPak arcPak cirPaks arcPaks newCirPaks newArcPaks)
  (setq sss (ssget) ss (entlast))
  (command "explode" sss "")
  (setq ss (entlast)
pt (getpoint "\n坐标原点: ")
ent (ssname ss 0)
i 0
dd (* (getvar "DIMSCALE") (+ (getvar "DIMTXT") (* 2.0 (getvar "DIMGAP"))))
posRec (list nil nil nil nil nil nil nil nil)
  )
  (command "UCS" "O" pt)
  (while ent
    (setq inf (ac-dimInf ent))
    (if inf
      (progn
(setq sub-xinfs (nth 0 inf)
       sub-yinfs (nth 1 inf)
       xs (append (nth 2 inf) xs)
       ys (append (nth 3 inf) ys)
       sEnt (nth 4 inf)
       cirPak (nth 5 inf)
       arcPak (nth 6 inf)
)
(foreach xinf1 sub-xinfs
   (setq xinf2 (assoc (car xinf1) xinfs))
   (if xinf2
     (setq xinfs (subst (list (car xinf2) (cadr xinf2) (append (nth 2 xinf2) (nth 2 xinf1))) xinf2 xinfs))
     (setq xinfs (cons xinf1 xinfs))
   )
)
(foreach yinf1 sub-yinfs
   (setq yinf2 (assoc (car yinf1) yinfs))
   (if yinf2
     (setq yinfs (subst (list (car yinf2) (cadr yinf2) (append (nth 2 yinf2) (nth 2 yinf1))) yinf2 yinfs))
     (setq yinfs (cons yinf1 yinfs))
   )
)
(if sEnt
   ;; un-orthogonal line
   (setq sEnts (cons sEnt sEnts))
)
(if cirPak
   (setq cirPaks (cons cirPak cirPaks))
)
(if arcPak
   (setq arcPaks (cons arcPak arcPaks))
)
      )
    )
    (setq i (1+ i)
   ent (ssname ss i)
    )
  )
  ;; find the center of objects
  (setq x1 (apply 'min xs)
x2 (apply 'max xs)
y1 (apply 'min ys)
y2 (apply 'max ys)
cpt (list (/ (+ x1 x2) 2.0) (/ (+ y1 y2) 2.0) 0.0)
gap (* 5.0 dd)
stPos (list (- x1 gap) (+ x2 gap) (- y1 gap) (+ y2 gap))
  )
  ;; dimension position
  (setq xinfs (vl-sort xinfs '(lambda(a b) (< (abs (- (cadr a) (car cpt))) (abs (- (cadr b) (car cpt))))))
yinfs (vl-sort yinfs '(lambda(a b) (< (abs (- (cadr a) (cadr cpt))) (abs (- (cadr b) (cadr cpt))))))
  )
  (ac-dimInfs xinfs cpt "x")
  (ac-dimInfs yinfs cpt "y")
  ;; dimension angle
  (foreach sEnt sEnts
    (ac-dimAngle sEnt)
  )
  ;; dimension diameter & radius
  (setq newCirPaks (ac-reducePaks cirPaks))
  (setq newArcPaks (ac-reducePaks arcPaks))
  (ac-dimCirArc newCirPaks "cir")
  (ac-dimCirArc newArcPaks "arc")
  (command "UCS" "P")
)
;;;
(defun ac-dimInf(ent / dat typ p1 p2 x1 y1 x2 y2 ang ang2 xs ys xinfs yinfs inf rad sEnt cirPak arcPak)
  (setq dat (entget ent)
typ (cdr (assoc 0 dat))
  )
  (cond ((= typ "LINE")
  (setq p1      (trans (cdr (assoc 10 dat)) 0 1)
        p2      (trans (cdr (assoc 11 dat)) 0 1)
        x1 (car p1)
        y1 (cadr p1)
        x2 (car p2)
        y2 (cadr p2)
        ang     (angle p1 p2)
        ang2 (rem ang pi)
        xs      (list x1 x2)
        ys      (list y1 y2)
        sEnt nil
  )
  (cond ((or (equal ang2 0.0 0.01) (equal ang2 pi 0.01) (equal ang2 (* 2.0 pi) 0.01))
  ;; horizontal
  (setq yinfs (list (list (rtos y1 2 4) y1 (list x1 x2)))
        xinfs nil
  )
        )
        ((or (equal ang2 (* 0.5 pi) 0.01) (equal ang2 (* 1.5 pi) 0.01))
  ;; vertical
  (setq xinfs (list (list (rtos x1 2 4) x1 (list y1 y2)))
        yinfs nil
  )
        )
        (T
  ;; un-orthogonal
  (setq yinfs (list (list (rtos y1 2 4) y1 (list x1)) (list (rtos y2 2 4) y2 (list x2)))
        xinfs (list (list (rtos x1 2 4) x1 (list y1)) (list (rtos x2 2 4) x2 (list y2)))
        sEnt ent
  )
        )
  )
  (setq inf (list xinfs yinfs xs ys sEnt nil nil))
)
((= typ "CIRCLE")
  (setq p1  (trans (cdr (assoc 10 dat)) 0 1)
        x1 (car p1)
        y1 (cadr p1)
        rad (cdr (assoc 40 dat))
        xs  (list (+ x1 rad) (- x1 rad))
        ys  (list (+ y1 rad) (- y1 rad))
        xinfs (list (list (rtos x1 2 4) x1 (list y1)))
        yinfs (list (list (rtos y1 2 4) y1 (list x1)))
        inf (list xinfs yinfs xs ys nil (list p1 rad ent) nil)
  )
)
((= typ "ARC")
  (setq p1 (trans (cdr (assoc 10 dat)) 0 1)
        rad (cdr (assoc 40 dat))
        xs (list (+ (car p1) rad) (- (car p1) rad))
        ys (list (+ (cadr p1) rad) (- (cadr p1) rad))
  )
  (setq inf (list nil nil xs ys nil nil (list p1 rad ent)))
)
((= typ "INSERT")
  (setq p1  (trans (cdr (assoc 10 dat)) 0 1)
        x1 (car p1)
        y1 (cadr p1)
        xs  (list x1)
        ys  (list y1)
        xinfs (list (list (rtos x1 2 4) x1 (list y1)))
        yinfs (list (list (rtos y1 2 4) y1 (list x1)))
        inf (list xinfs yinfs xs ys nil (list p1 rad ent) nil)
  )
)
  )
  inf
)
;;;
(defun ac-dimPtPair (p1 p2 cpt dir)
  (if (> (distance p1 cpt) (distance p2 cpt))
    (ac-dimOrd p1 (angle p2 p1) cpt dir)
    (ac-dimOrd p2 (angle p1 p2) cpt dir)
  )
)
;;;
(defun ac-dimPtSingle (pt cpt dir / v)
  (setq v (mapcar '- pt cpt))
  (cond ((= dir "y")
  (if (> (car v) 0.0)
    (ac-dimOrd pt 0.0 cpt dir)
    (ac-dimOrd pt pi cpt dir)
  )
)
((= dir "x")
  (if (> (cadr v) 0.0)
    (ac-dimOrd pt (* 0.5 pi) cpt dir)
    (ac-dimOrd pt (* 1.5 pi) cpt dir)
  )
)
  )
)
;;;
(defun ac-dimInfs (infs cpt dir / a bs b1 b2 p1 p2)
  (foreach inf infs
    (setq a  (cadr inf)
   bs (vl-sort (nth 2 inf) '<)
    )
    (if (= (length bs) 1)
      (cond ((= dir "x")
      (setq p1 (list a (car bs) 0.0))
      (ac-dimPtSingle p1 cpt dir)
     )
     ((= dir "y")
      (setq p1 (list (car bs) a 0.0))
      (ac-dimPtSingle p1 cpt dir)
     )
      )
      (cond ((= dir "x")
      (setq p1 (list a (car bs) 0.0)
     p2 (list a (last bs) 0.0)
      )
      (if (equal p1 p2 1e-5)
        (ac-dimPtSingle p1 cpt dir)
        (ac-dimPtPair p1 p2 cpt dir)
      )
     )
     ((= dir "y")
      (setq p1 (list (car bs) a 0.0)
     p2 (list (last bs) a 0.0)
      )
      (if (equal p1 p2 1e-5)
        (ac-dimPtSingle p1 cpt dir)
        (ac-dimPtPair p1 p2 cpt dir)
      )
     )
      )
    )
  )
)
;;;
;;; global variables: dd, posRec
;;; stPos: (x1 x2 y1 y2)
(defun ac-dimOrd (pt ang cpt dir / area pp px py dd2 pp2)
  (cond ((or (equal ang 0.0 0.001) (equal ang (* 2.0 pi) 0.001))
  (if (> (cadr pt) (cadr cpt))
    (setq area 7)
    (setq area 6)
  )
)
((equal ang pi 0.001)
  (if (> (cadr pt) (cadr cpt))
    (setq area 5)
    (setq area 4)
  )
)
((equal ang (* 0.5 pi) 0.001)
  (if (> (car pt) (car cpt))
    (setq area 3)
    (setq area 2)
  )
)
((equal ang (* 1.5 pi) 0.001)
  (if (> (car pt) (car cpt))
    (setq area 1)
    (setq area 0)
  )
)
  )
  (setq pp (nth area posRec))
  (cond ((= area 0)
  (setq px (car pt)
        py (nth 2 stPos)
  )
  (if pp
    (progn
      (setq dd2 (- (- pp px) dd))
      (if (< dd2 0.0)
        (setq px (+ px dd2))
      )
    )
  )
  (setq pp2 px)
)
((= area 1)
  (setq px (car pt)
        py (nth 2 stPos)
  )
  (if pp
    (progn
      (setq dd2 (- (- px pp) dd))
      (if (< dd2 0.0)
        (setq px (- px dd2))
      )
    )
  )
  (setq pp2 px)
)
((= area 2)
  (setq px (car pt)
        py (nth 3 stPos)
  )
  (if pp
    (progn
      (setq dd2 (- (- pp px) dd))
      (if (< dd2 0.0)
        (setq px (+ px dd2))
      )
    )
  )
  (setq pp2 px)
)
((= area 3)
  (setq px (car pt)
        py (nth 3 stPos)
  )
  (if pp
    (progn
      (setq dd2 (- (- px pp) dd))
      (if (< dd2 0.0)
        (setq px (- px dd2))
      )
    )
  )
  (setq pp2 px)
)
((= area 4)
  (setq px (nth 0 stPos)
        py (cadr pt)
  )
  (if pp
    (progn
      (setq dd2 (- (- pp py) dd))
      (if (< dd2 0.0)
        (setq py (+ py dd2))
      )
    )
  )
  (setq pp2 py)
)
((= area 5)
  (setq px (nth 0 stPos)
        py (cadr pt)
  )
  (if pp
    (progn
      (setq dd2 (- (- py pp) dd))
      (if (< dd2 0.0)
        (setq py (- py dd2))
      )
    )
  )
  (setq pp2 py)
)
((= area 6)
  (setq px (nth 1 stPos)
        py (cadr pt)
  )
  (if pp
    (progn
      (setq dd2 (- (- pp py) dd))
      (if (< dd2 0.0)
        (setq py (+ py dd2))
      )
    )
  )
  (setq pp2 py)
)
((= area 7)
  (setq px (nth 1 stPos)
        py (cadr pt)
  )
  (if pp
    (progn
      (setq dd2 (- (- py pp) dd))
      (if (< dd2 0.0)
        (setq py (- py dd2))
      )
    )
  )
  (setq pp2 py)
)
  )
  ;; reorder posRec
  (setq posRec (mapcar '(lambda (i / r)
     (if (= i area)
       (setq r pp2)
       (setq r (nth i posRec))
     )
     r
   )
         '(0 1 2 3 4 5 6 7)
        )
  )
  ;; dimension
  (command "DIMORDINATE" "none" pt dir "none" (list px py 0.0))
)
;;; dimension angle
(defun ac-dimAngle (ent / dat p1 p2 sPt ang ang2 ang3 str box v h s dis ePt1 ePt2 tmpPt box1 box2 ss1 ss2 n1 n2 ept)
  (setq dat (entget ent)
p1  (trans (cdr (assoc 10 dat)) 0 1)
p2  (trans (cdr (assoc 11 dat)) 0 1)
sPt (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
ang (angle p1 p2)
ang2 (rem ang pi)
ang3 (rem ang (/ pi 2.0))
  )
  (if (> ang3 (/ pi 4.0))
    (setq ang3 (- (/ pi 2.0) ang3))
  )
  (setq str (angtos ang3 0)
str (strcat str "%%d")
box (textbox (list (cons 1 str)))
v   (mapcar '(lambda (a b) (- b a)) (car box) (cadr box))
h   (/ (cadr v) 2.0)
s   (getvar "DIMSCALE")
  )
  (if (= s 0.0)
    (setq s 1.0)
  )
  (setq dis   (* s (getvar "DIMTXT") 5))
  (if (> ang2 (/ pi 2.0))
    (setq ePt1 (polar sPt (/ pi 6.0) dis)
   ePt2 (polar sPt (/ (* 7.0 pi) 6.0) dis)
   tmpPt (list (nth 0 ePt1) (- (nth 1 ePt1) h) (nth 2 ePt1))
   box1 (list tmpPt (mapcar '+ tmpPt v))
   tmpPt (list (nth 0 ePt2) (+ (nth 1 ePt2) h) (nth 2 ePt2))
   box2 (list (mapcar '- tmpPt v) tmpPt)
    )
    (setq ePt1 (polar sPt (/ (* 5.0 pi) 6.0) dis)
   ePt2 (polar sPt (/ (* 11.0 pi) 6.0) dis)
   tmpPt (list (nth 0 ePt1) (+ (nth 1 ePt1) h) (nth 2 ePt1))
   box1 (list (mapcar '- tmpPt v) tmpPt)
   tmpPt (list (nth 0 ePt2) (- (nth 1 ePt2) h) (nth 2 ePt2))
   box2 (list tmpPt (mapcar '+ tmpPt v))
    )
  )
  ;;
  (setq ss1 (ssget "C" (car box1) (cadr box1))
ss2 (ssget "C" (car box2) (cadr box2))
  )
  (if ss1
    (setq n1 (sslength ss1))
    (setq n1 0)
  )
  (if ss2
    (setq n2 (sslength ss2))
    (setq n2 0)
  )
  (if (<= n1 n2)
    (setq ePt ePt1)
    (setq ePt ePt2)
  )
  ;;
  (command "LEADER" "none" sPt "none" ePt "" str "")
)
;;; dimension diameter & radius
;;;
(defun ac-dimCirArc(paks typ / pt rad ent rads rTxt sym dec dimEnt txtCen txtBox hv p1 p2 ang stAng wAng obj ang1 len)
  (foreach pak paks
    (setq pt  (nth 0 pak)
   rads (nth 1 pak)
   rad (last rads)
   ent (nth 2 pak)
   dec (getvar "DIMDEC")
   rTxt ""
    )
    (if (= typ "cir")
      (setq sym "%%c")
      (setq sym "R")
    )

    (if (= typ "cir")
      (progn
    (foreach r (reverse (cdr rads))
              (setq rTxt (strcat ", " sym (rtos (* 2.0 r) 2 dec) rTxt))
           )
           (setq rTxt (strcat sym (rtos (* 2.0 (car rads)) 2 dec) rTxt))
(command "DIMDIAMETER" (list ent (polar pt 0.0 rad)) "t" rTxt "none" (polar pt 0.0 rad))
(setq stAng (/ pi 4.0)
       wAng (+ pi 0.01)
)
      )
      (progn
    (foreach r (reverse (cdr rads))
              (setq rTxt (strcat ", " sym (rtos (* 1.0 r) 2 dec) rTxt))
           )
           (setq rTxt (strcat sym (rtos (* 1.0 (car rads)) 2 dec) rTxt))
(command "DIMRADIUS" (list ent (polar pt 0.0 rad)) "t" rTxt "none" (polar pt 0.0 rad))
(setq obj (vlax-ename->vla-object ent)
       ang1 (vla-get-startAngle obj)
       len (vla-get-arcLength obj)
       wAng (/ len rad 2.0)
       stAng (+ ang1 wAng)
)
      )
    )
    (setq dimEnt (entlast)
   txtCen (trans (cdr (assoc 11 (entget dimEnt))) 0 1)
   txtBox (textbox (list (cons 1 rTxt)))
   hv (mapcar '(lambda(a b) (/ (- b a) 2.0)) (car txtBox) (cadr txtBox))
   p1 (mapcar '- txtCen hv)
   p2 (mapcar '+ txtCen hv)
    )
    (entdel dimEnt)
    (setq ang (ac-findAng pt p1 p2 stAng wAng (/ pi 16.0)))
    (entdel dimEnt)
    (command "ROTATE" dimEnt "" "none" pt (angtos ang))
  )
)
;;;
(defun ac-reducePaks (paks / pt rad ent infs ptStr inf subPaks newPak newPaks)
  (foreach pak paks
    (setq pt (nth 0 pak)
   rad (nth 1 pak)
   ent (nth 2 pak)
   ptStr (strcat (rtos (car pt) 2 4) "," (rtos (cadr pt) 2 4))
   inf (assoc ptStr infs)
    )
    (if inf
      (setq infs (subst (append inf (list pak)) inf infs))
      (setq infs (cons (list ptStr pak) infs))
    )
  )
  (foreach inf infs
    (setq subPaks (vl-sort (cdr inf) '(lambda(a b) (< (cadr a) (cadr b))))
   newPak (list (caar subPaks) (mapcar 'cadr subPaks) (caddr (last subPaks)))
   newPaks (cons newPak newPaks)
    )
  )
  newPaks
)
;;;
(defun ac-findAng (cen p1 p2 stAng wAng dAng / p3 p4 pts ang ck dir ang2 pts2 ss fAng minS)
  (setq p3  (list (car p1) (cadr p2) 0.0)
p4  (list (car p2) (cadr p1) 0.0)
pts (list p1 p3 p2 p4)
ang 0.0
ck T
  )
  (while ck
    (setq dir T)
    (repeat 2
      (if ck
(progn
   (if dir
     (setq ang2 (+ stAng ang))
     (setq ang2 (- stAng ang))
   )
   (setq pts2 (mapcar '(lambda (a)
    (ac-newPos a cen ang2)
         )
        pts
       )
  dir  (not dir)
  ss   (ssget "cp" pts2)
   )
   (if ss
     (progn
       (if fAng
  (if (< (sslength ss) minS)
    (setq fAng ang2
   minS (sslength ss)
    )
  )
  (setq fAng ang2
        minS (sslength ss)
  )
       )
     ); -progn
     (setq fAng ang2
    ck nil
     )
   ); -if
); -progn
      ); -if
    )
    (if ck
      (setq ang (+ ang dAng)
     ck (<= ang wAng)
      )
    )
  )
  fAng
)
;;;
(defun ac-newPos(pt cen ang / pt2 x1 y1 x2 y2 c s)
  (setq pt2 (mapcar '- pt cen)
x1 (car pt2)
y1 (cadr pt2)
c (cos ang)
s (sin ang)
x2 (- (* x1 c) (* y1 s))
y2 (+ (* x1 s) (* y1 c))
pt2 (mapcar '+ (list x2 y2 0.0) cen)
  )
  pt2
)

newer

行雲 发表于 2016-12-23 20:10

你这个程序是做什么的？ 你想把它改成什么样？

行雲

newer 发表于 2016-12-23 20:21

是个标注工具，标注前要人工将多义线炸开才能用，繁琐，所以想在ss处加个炸开动作，炸开后 ent (ssname ss 0)接着往下做。。。

标注完成后，如果这个ss还能用，想再次用PEDIT把炸开的图元串起来

/db_自贡黄明儒_

多段线(command "explode" sss "")炸开后，可以用(setq ss (commnad "select" "P))取得炸开后的选择集。
不是有多段的标注吗，找一个不就得了？

Lisphk

行雲 发表于 2016-12-23 20:44

这样的功能？

                               
登录/注册后可看大图

http://bbs.xdcad.net/thread-704609-1-1.html

行雲

/db_自贡黄明儒_ 发表于 2016-12-23 20:48

谢谢你。改成这样
   (setq sss (ssget) ss (entlast))
   (command "explode" sss "")
   (setq ss (commnad "select" "P)
cad报  错误: 输入的字符串太长
再给个方法行不？谢谢

Lisphk

行雲 发表于 2016-12-23 21:03

"P))  你这个地方P后面缺个引号

行雲

Lisphk 发表于 2016-12-23 21:08

  (setq sss (ssget) ss (entlast))
  (command "explode" sss "")
   (setq ss (commnad "select" "P") ；；这里没能接起来  
          pt (getpoint "\n坐标原点: ")
          ent (ssname ss 0)
          i 0
          dd (* (getvar "DIMSCALE") (+ (getvar "DIMTXT") (* 2.0 (getvar "DIMGAP"))))
          posRec (list nil nil nil nil nil nil nil nil)
   )

或这样
  (setq ss (ssget))
  (command "explode" ss "")
   (setq ss (commnad "select" "P") ；；这里没能接起来  
          pt (getpoint "\n坐标原点: ")
          ent (ssname ss 0)
          i 0
          dd (* (getvar "DIMSCALE") (+ (getvar "DIMTXT") (* 2.0 (getvar "DIMGAP"))))
          posRec (list nil nil nil nil nil nil nil nil)
   )

Lisphk

行雲 发表于 2016-12-23 21:29

不针对你的程序，只针对你这行代码

(commnad "select" "P") , 你這行代碼有兩個問題
1、是 command   不是 commnad

2、这是执行select命令，所以你可以在命令行後面粘貼執行，看看代碼需要什麽

你給完P參數后，要回車結束命令。所以，應該：

(command "select" "P" "")


你应该多看看论坛的帖子，多看看代码，再去修改或者写程序，很多基础的地方要把基础打牢。