[讨论]如何選取弧,刪除弧上的文字

f5612140

如題,文字插入點在弧上

meflying

(setq a 0.1)控制精度

2. (defun c:test( / ents start_ang end_ang pt_center r ss i ent pt ang a)
3.    (defun between(ang ang1 ang2)
4.        (cond
5.            ((< ang1 ang2) (and (>= ang start_ang) (<= ang end_ang)))
6.            ((> ang1 ang2) (or (>= ang start_ang) (<= ang end_ang)))
7.        )
8.    )
9.    (setq a 0.1)
10.    (setq ents (entget (car (entsel "选择圆弧..."))))
11.    (setq start_ang (cdr (assoc 50 ents)))
12.    (setq end_ang (cdr (assoc 51 ents)))
13.    (setq pt_center (cdr (assoc 10 ents)))
14.    (setq r (cdr (assoc 40 ents)))
15.    (setq ss (ssget "x" '((0 . "text,mtext"))))
16.    (setq i 0)
17.    (repeat (sslength ss)
18.        (setq ent (ssname ss i))
19.        (setq pt (cdr (assoc 10 (entget ent))))
20.        (if (and (equal r (distance pt pt_center) a) (between (angle pt_center pt) start_ang end_ang))
21.            (entdel ent)
22.        )
23.        (setq i (1+ i))
24.    )
25.    (princ)
26. )
27.       

(defun c:test( / ents start_ang end_ang pt_center r ss i ent pt ang a)    (defun between(ang ang1 ang2)        (cond            ((< ang1 ang2) (and (>= ang start_ang) (<= ang end_ang)))            ((> ang1 ang2) (or (>= ang start_ang) (<= ang end_ang)))        )    )    (setq a 0.1)    (setq ents (entget (car (entsel "选择圆弧..."))))    (setq start_ang (cdr (assoc 50 ents)))    (setq end_ang (cdr (assoc 51 ents)))    (setq pt_center (cdr (assoc 10 ents)))    (setq r (cdr (assoc 40 ents)))    (setq ss (ssget "x" '((0 . "text,mtext"))))    (setq i 0)    (repeat (sslength ss)        (setq ent (ssname ss i))        (setq pt (cdr (assoc 10 (entget ent))))        (if (and (equal r (distance pt pt_center) a) (between (angle pt_center pt) start_ang end_ang))            (entdel ent)        )        (setq i (1+ i))    )    (princ) )       

无痕

(if (equal 0 (vlax-curve-getclosestpointto         arcobj (vla-get-InsertionPoint         textobj) )         0.1)


....

无痕

2. ;选择圆弧上的文字,文字插入点在圆弧上-----------------------------------无痕.2004.2
3. (defun c:getarctt (/ arcobj sstxt ss n textobj textpt)
4.    (setq arcobj (vlax-ename->vla-object (car(entsel "\n选择圆弧:"))))
5.    (vla-GetBoundingBox arcobj 'minpt 'maxpt);;
6.    (setq sstxt (ssadd)
7.   ss (ssget "c" (vlax-safearray->list minpt) (vlax-safearray->list maxpt) '((0 . "*text"))))
8.    (repeat (setq n (sslength ss))
9.        (setq textobj (vlax-ename->vla-object (setq e (ssname ss (setq n (1- n)))))
10.      textpt (vlax-get textobj 'InsertionPoint))
11.        (if (equal 0 (distance textpt (vlax-curve-getclosestpointto arcobj textpt 0))   0.1)
12.                (setq sstxt (ssadd   e sstxt))
13.        )
14.    )(sssetfirst sstxt sstxt)
15. )

;选择圆弧上的文字,文字插入点在圆弧上-----------------------------------无痕.2004.2 (defun c:getarctt (/ arcobj sstxt ss n textobj textpt)    (setq arcobj (vlax-ename->vla-object (car(entsel "\n选择圆弧:"))))    (vla-GetBoundingBox arcobj 'minpt 'maxpt);;    (setq sstxt (ssadd)   ss (ssget "c" (vlax-safearray->list minpt) (vlax-safearray->list maxpt) '((0 . "*text"))))    (repeat (setq n (sslength ss))        (setq textobj (vlax-ename->vla-object (setq e (ssname ss (setq n (1- n)))))      textpt (vlax-get textobj 'InsertionPoint))        (if (equal 0 (distance textpt (vlax-curve-getclosestpointto arcobj textpt 0))   0.1)                (setq sstxt (ssadd   e sstxt))        )    )(sssetfirst sstxt sstxt) )

f5612140

to:meflying


感謝,獻花一朵


to:无痕


會出現 "損壞的引數類型: safearrayp nil"

无痕

已经修改了。 将(vlax-invoke arcobj 'GetBoundingBox 'minpt 'maxpt)
改为(vla-GetBoundingBox arcobj 'minpt 'maxpt)

meflying

to:无痕 vlax-curve-getclosestpointto这一类函数支持ename对象，无意中发现的

f5612140

to:无痕 Ok,獻花一朵

龙龙仔

无痕发表于2004-3-10 13:52:00已经修改了。 将(vlax-invoke arcobj 'GetBoundingBox 'minpt 'maxpt) 改为(vla-GetBoundingBox arcobj 'minpt 'maxpt)

改;(vlax-invoke-method arcobj 'GetBoundingBox 'minpt 'maxpt)

无痕

谢谢lucas，我说这次怎么不行了呢？原来是漏了method ：），一时间没转过神来，不好意思