对于只有一个文本的圆，您仍然使用相同的块吗？将填充什么属性标记？单位、类型或INSTNO？如果有不同的街区，请在这里张贴。？你需要为我们提供所有的可能性[可能不是全部，但…]，我敢肯定，只要我们考虑所有的变量，这很容易。 谢谢你的帮助。我修改了我的例行程序，以提高它一点，但我仍然没有完全得到它的权利（感谢这里的一个成员pm'ing我一些帮助）。
我想让它删除圆圈和3行文字后插入我的新块，而不必选择一个窗口，然后删除我的新块。我肯定有办法，我只是还没想出来。因此，“实体”就是圆。我应该可以把它抹掉，对吗？但是，我如何调出我选择删除它们的文本行呢？
请参阅下面我的最新迭代。再次感谢。
;定义功能-instbub，用ibb4激活
（定义c:ibb4（）
;定义picktext以供以后在脚本中使用
（defun picktext（）（setq en1（car（entsel“\n选择单元文本：”））（setq el1（entget en1））
（如果（=（cdr（assoc 0 el1））“文本”）
（setq ans（assoc 1 el1））
)
)
;结束defun
（defun picktext2（）（setq en1（car（entsel“\n选择类型文本：”）））（setq el1（entget en1））
（如果（=（cdr（assoc 0 el1））“文本”）
（setq ans（assoc 1 el1））
)
)
;结束defun
（defun picktext3（）（setq en1（car（entsel“\n选择Numb text:）））（setq el1（entget en1））
（如果（=（cdr（assoc 0 el1））“文本”）
（setq ans（assoc 1 el1））
)
)
;结束defun************************
（（defun点（insertionpoint））
（entmakex）
（列表
（cons 0“点”）
（cons 10插入点）
)
)
)
（如果
（和
（setq实体（car（entsel“\n请选择一个圆：”））
（eq“CIRCLE”（cdr（assoc 0（setq entity（entget entity）1072;）а））））
)
（点（cdr（assoc 10实体）））
)
;
;
;
（setq pt（cdr（assoc 10实体）））
;从文本元素获取单元名称
（picktext）
（setq unitname ans）
;从文本元素获取仪器类型
（picktext2）
（setq INSTANS型）
;从文本元素获取仪器编号
（picktext3）
（setq INSTNUM ans）
; 根据上面存储的信息插入仪器气泡
（命令“attdia”“0”）
（命令“-insert”“instrub.DWG”“\u non”pt“1”“1”“0”（cdr unitname）（cdr insttype）（cdr instnumb））
（setq old（ssget））
（命令“ERASE”old“R”“L”）
)
（普林斯）
) 如果你回到我的帖子，你会看到我建议你选择圆圈并在里面查找文本，同时分别保存每个实体的名称obj obj2 obj3 obj4将你的代码el1等更改为el1 el2 el3，然后你可以找到它们并删除。您也只需要选择文本defun，一旦您可以处理发送给defun的问题，并使每个单独的变量=ans。
我会尽量抽出时间来为你挑选圈内的一切。
像Pbe一样，一次只能尝试一条规则并不断增强。
真的
现在，我编写了一个测试代码，可以在您附带的绘图上使用 AL, I did see that and that makes sense, thank you, I just am not sure how to implement what you suggested. I am just picking my way thru writing this. This is the third time I've tried to write a lisp routine, so I am having to figure out every command as I go.
Pbe, Thank you as well. I am looking at what you wrote and trying to make sense of it. Did you just write that from scratch? If so, I am even more intimidated by this now. There is a LOT going on there that I don't understand. I basically have to go thru one line at a time and figure it out and its taking me a while. I ran the routine on my example and it worked great, but when I tried it on a full drawing, it doesn't work, just returns nil. I am not able to attach a full drawing for you (proprietary).
To try and clarify what I am trying to accomplish, I'll attempt to give a better explanation. The company I am working for has approx. 1000 P&IDs that have been drawn/modified over the past 25 years with very little standardization. I have tried to standardize symbology, but for years they let various contractors modify the drawings with little oversight. The result is nothing is the same from drawing to drawing. I need all of the instrument bubbles to be a block with 3 attributes (unit/instrument type/instrument number). There may be 5 instrument bubbles on one drawing and 80 on the next.
Some of the existing bubbles are a circle with 3 lines of text, some are a block (a circle with various hidden attribute data that is not needed) with 3 lines of text, and some are various other things. Really too many different examples to show them all.
I want to automate as much of this process as I can, but I have to make sure that I get them all, even if I have to manually do a few odd ones.
I am attaching a new example drawing that shows some of the various different examples I'm dealing with.
example3.dwg its an easy fix, at least now i have some other conditions to work on..... i'll see what i can do.
EDIT:
At first glance, we need to somehow filter those BLOCKS/CIRCLE "at the same coord",
65% OF THE OCCURANCES ON ALL OF MY DRAWINGS: Done
Also blocks with a none center insertion point. the rest is easy: Done
Circles with two or three TEXT : Done
1 or 2 Attributes: Done
Text/Attribute: DONE
Block/Circle: DONE
Circle radius:DONE pBe,
That routine is so far beyond my understanding. Could you add some comments to it to describe what is going on there? Watch this space I wrote last night use a circle as ssget filter to retrieve the text its still a work in progress. Doinf it for anyone that may need something like that. I appreciate Pbe is working hard on a full answer, here is amethod of finding objects inside a circle along the lines of the code you started to write which uses a moreautomated approach, at the moment it uses a manual pick of circles but that would be removed to a pick all to be changed. A word of caution it deletes the objects as a test stage, undo will bring back. As I hinted I would make it find all wether it be 1 2 3 or more text entries.
; started life as converts a circle to a series of chords; now find objects inside a circle(vl-load-com)(setq oldsnap (getvar "osmode"))(setvar "osmode" 0)(setq oldecho (getvar "cmdecho"))(setvar "cmdecho" 0)(while (setq ent (entsel "\nPick circle: "));(if (= div nil) (setq div (getint "\nEnter number of chords: "))) (setq div 20) ; works ok(setq obj (vlax-ename->vla-object (car ent))) (setq angdiv (/ (* 2.0 pi) div))(setq cenpt (vlax-safearray->list (vlax-variant-value (vla-get-center obj))))(setq rad (vla-get-radius obj))(setq ang 0.0)(repeat div(setq newpt (polar cenpt ang rad))(setq lst (cons (list (car newpt)(cadr newpt)) lst))(setq ang (+ ang angdiv))) ;repeat; select text inside a circle; selection set of text within polygon(setq ss (ssget "_WP" lst '((0 . "Text,Mtext"))));if always 3 do this way else repeat as required for sslength of ss for variable number of texts(setq t1 (vla-get-textstring (vlax-ename->vla-object (ssname ss 0))))(setq t2 (vla-get-textstring (vlax-ename->vla-object (ssname ss 1))))(setq t3 (vla-get-textstring (vlax-ename->vla-object (ssname ss 2))))(alert (strcat t1 " " t2 " " t3)); now lets delete all (setq x (sslength ss))(while (setq ent2 (ssname ss (setq x (- x 1)))) (entdel ent2)) ; delete text inside(entdel (car ent)) ;delete circle(setq ss nil lst nil)) ; end while ; now do insert new block !!!!(alert "stage 2 not done yet")) ; end while (setvar "cmdecho" oldecho)(setvar "osmode" oldsnap)(princ)
part 2 this makes squares and circles as block with text or numbers
; bubble pt num; BY ALAN AUG 2014(defun make_circle () (entmake (list (cons 0 "CIRCLE") (cons 8 "0") (cons 10 (list 0 0 0)) (cons 40 3.25) ; rad (cons 210 (list 0 0 1)) (cons 62 256) (cons 39 0) (cons 6 "BYLAYER")) )) ; DEFUN(defun make_sq () (setq vertexList (list (list -3.25 -3.25 0.) (list 3.25 -3.25 0.) (list 3.25 3.25 0.) (list -3.25 3.25 0.) )) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length vertexList)) (cons 70 1) ; 1 closed : 0 open (cons 8 "0") (cons 38 0.0) (cons 210 (list 0.0 0.0 1.0)) ) (mapcar '(lambda (pt) (cons 10 pt)) vertexList) ) )) ; defun(defun Make_bubble ( ) (entmake (list (cons 0 "BLOCK") (cons 2 Blkname) (cons 70 2) (cons 10 (list 0 0 0)) (CONS 8 "0") )) (if (= resp "C") (make_circle) (make_sq) ) (entmake (list (cons 0 "ATTDEF") (cons 8 "0") (cons 10 (list 0 0 0)) (cons 1 "1") ; default value (cons 2 blkname) ; nblock name (cons 3 "Ptnum") ; tag name (cons 6 "BYLAYER") (cons 7 "STANDARD") ;text style (cons 8 "0") ; layer (cons 11 (list 0.0 0.0 0.0)) ; text insert pt (cons 39 0) (cons 40 3.5) ; text height (cons 41 1) ; X scale (cons 50 0) ; Text rotation (cons 51 0) ; Oblique angle (cons 62 256) ; by layer color (cons 70 0) (cons 71 0) ;Text gen flag (cons 72 1) ; Text Justify hor 1 center (cons 73 0) ; field length (cons 74 2) ; Text Justify ver 2 center (cons 210 (list 0 0 1)) )) (entmake (list (cons 0 "ENDBLK"))) (princ))(defun C:bub (/ ptnum ptnumb pt pt2 oldsnap chrnum sc curspace) (if (= 1 (getvar 'cvport)) (setq sc 1.0) (setq sc (/ 1000.0 (getreal "\nEnter plotting scale"))) ) (setq oldsnap (getvar "osmode")) (setvar "textstyle" "standard") (setq ptnum (getstring "\nEnter Pt Number or alpha")) (setq chrnum (ascii (substr ptnum 1 1))) ; 1st character is number (if (< chrnum 58) (setq ptnumb (atof ptnum)) ;convert back to a number) (while (setq pt (getpoint "\Pick end of line Enter to exit")) (setq pt2 (polar pt (/ pi 2.0) 3.25)) (setvar "osmode" 0) (if (< chrnum 58) (progn(command "-insert" blkname pt sc "" 0 (rtos ptnumb 2 0))(setq ptnumb (+ ptnumb 1)) ) (progn(command "-insert" blkname pt sc "" 0 (chr chrnum))(setq chrnum (+ chrnum 1)) ) ) (command "move" "L" "" pt pt2) (setvar "osmode" 1) ) (setvar "osmode" oldsnap) (princ)) ; end defun;;;;;; ; program starts here checking (alert "Type Bub to repeat\nYou can do alpha's or numbers\nSquare or circles")(initget 6 "S s C c")(setq resp (strcase (Getkword "\nDo you want Circle or Square C or S") ))(if (or (= resp "C") (= resp nil)) (setq blkname "SETOUT_POINT_NO") (setq blkname "SETOUT_POINT_NOSQ"))(if (/= (tblsearch "BLOCK" blkname) NIL)(PRINC "FOUND") ; block exists(Make_bubble))(C:BUB)(princ) (defun c:fixmeplease (/ _inside-pblocks space circoll textcoll ss e Exlst insidecircle );;;pBe October 2015 ;;; (defun _inside-p (pt obj / lst Yoray) (setq lst (vlax-invoke (setq Yoray (vla-addray (vla-objectidtoobject(vla-get-document obj)(vla-get-ownerid obj) ) (vlax-3D-point pt) (vlax-3D-point (mapcar '+ pt '(1.0 0.0 0.0))) ) ) 'intersectwith obj acextendnone ) ) (vla-delete Yoray) (= 1 (logand 1 (length lst))) )(defun filter (condition lst) (vl-remove-if-not '(lambda (o) (Eval condition)) lst)) (defun _text-p (lst cir / insidecircle)(foreach txt lst(if (_inside-p (vlax-get txt 'insertionpoint) cir) (setq insidecircle (cons (list (vla-get-textstring txt) (vlax-get txt 'insertionpoint) txt ) insidecircle ) textcoll (vl-remove txt textcoll) ))) insidecircle ) (defun _sort (lst) (vl-sort lst '(lambda (a b)(> (cadadr a) (cadadr b))))) (defun _Insblock (spc src bn s )(vlax-invoke spc 'InsertBlock (vlax-get src 'Center) bn s s s 0 )) (defun _Wvtb(obj slst)(mapcar '(lambda (x y) (vla-put-textstring x y) y ) (vlax-invoke obj 'GetAttributes) slst )) (setq LAyForOniladoc (vla-get-ActiveDocument (vlax-get-acad-object))blocks (vla-get-blocks adoc )space(vla-get-modelspace aDoc))(vlax-for l (vla-get-layersaDoc)(if (equal '(-1 0) (mapcar '(lambda (v) (vlax-get l v) ) '("LayerOn" "Freeze") ) ) (setq LAyForO (cons (vla-get-name l) LAyForO) )))(if (and (setq blkn (cond ((tblsearch "BLOCK" "instrbub") "instrbub") ((findfile "instrbub.dwg")))) (setq textcoll nil blkcoll nil circollnil ss (ssget '((410 . "Model") (-4 . "") ) ) ) ) (progn (repeat (setq i (sslength ss))(setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))(cond((eq (setq objtyp (vla-get-ObjectName e)) "AcDbText") (setq textcoll (cons e textcoll)))((eq objtyp "AcDbCircle") (setq circoll (cons (list e nil) circoll)))((and (eq objtyp "AcDbBlockReference") (not (member (setq on nil bn (vla-get-EffectiveName e) ) Exlst ) ) ) (vlax-for itm (vla-item blocks bn) (setq on (cons (list (vla-get-ObjectName itm) itm) on)) ) (if (and (setq p (vl-position "AcDbCircle" (mapcar 'car (setq on (reverse on))) ) ) ) (setq blkcoll (cons (list p on e) blkcoll ) ) (setq Exlst (cons bn Exlst)) ))) ) (foreach blk blkcoll(Setq txtentnil atr nil atb nil content (cadr blk) ipt (vlax-get (last blk) 'Insertionpoint))(setq circleinsideblock (nth (car blk) content))(Setq refcircle (vlax-invoke space 'Addcircle (mapcar '+ ipt (vlax-get (cadr circleinsideblock) 'center) ) (* (vlax-get (cadr circleinsideblock) 'Radius) (abs (vlax-get (last blk) 'XScaleFactor)) ) ) crad (vla-get-radius refcircle))(foreach atr (vlax-invoke (last blk) 'Getattributes)(if (and (member (vla-get-layer atr) LAyForO) (_inside-p (Setq spot (vlax-get atr 'insertionpoint)) refcircle ) ) (setq atb (cons (list (vla-get-textstring atr) spot) atb))))(foreach txt (mapcar 'cadr (filter '(eq "AcDbText" (Car o)) content) )(if (and (member (vla-get-layer txt) LAyForO) (_inside-p (Setq spot (mapcar '+ ipt (vlax-get txt 'insertionpoint)) ) refcircle ) ) (setq txtent (cons (list (vla-get-textstring txt) spot) txtent) )))(setq txoutside (_text-p textcoll refcircle))(setq sc (/crad 0.250))(if (setq allstr (apply 'append (list atb txtent txoutside)))(progn (setq str2write (_sort allstr)) (setq atb (_Insblock space refcircle blkn sc)) (_Wvtb atb (mapcar 'car str2write)) (foreach tbd (append (mapcar 'last txoutside) (list (last blk) refcircle) ) (vla-delete tbd) ))(progn (vla-delete refcircle) (vla-delete (last blk)))) ) (foreach cir circoll (if(setq insidecircle (_text-p textcoll (car cir))) (progn (setq sc (/ (vla-get-radius (car cir)) 0.250)) (setq insidecircle (setq str2write (_sort insidecircle))) (setq str2write (mapcar 'car insidecircle)) (setq atb (_Insblock space (car cir) blkn sc)) (_Wvtb atb (if (= (length insidecircle) 2) (cons "E" str2write) str2write)) (foreach en cir (if en (Vla-delete en))) (foreach tx_ insidecircle (vla-delete (last tx_))) ) (vla-delete (car cir)) ) ) ) (princ (cond ((null blkn) "\n>") ((null ss) "\n>"))) ) (princ) )
页:
1
[2]