插入具有属性a的块

pBe · 发表于 2022-7-5 19:00:07

如果问题是目标文本和圆的一致性[层/文本样式/文本高度等]，那么运行脚本将是一个问题，不是吗？但这绝对是可行的，[通过这样的脚本]

对于只有一个文本的圆，您仍然使用相同的块吗？将填充什么属性标记？单位、类型或INSTNO？如果有不同的街区，请在这里张贴。？你需要为我们提供所有的可能性[可能不是全部，但…]，我敢肯定，只要我们考虑所有的变量，这很容易。

rmr jam · 发表于 2022-7-5 19:06:24

谢谢你的帮助。我修改了我的例行程序，以提高它一点，但我仍然没有完全得到它的权利（感谢这里的一个成员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”）
)
（普林斯）
)

BIGAL · 发表于 2022-7-5 19:07:37

如果你回到我的帖子，你会看到我建议你选择圆圈并在里面查找文本，同时分别保存每个实体的名称obj obj2 obj3 obj4将你的代码el1等更改为el1 el2 el3，然后你可以找到它们并删除。您也只需要选择文本defun，一旦您可以处理发送给defun的问题，并使每个单独的变量=ans。

我会尽量抽出时间来为你挑选圈内的一切。

像Pbe一样，一次只能尝试一条规则并不断增强。

pBe · 发表于 2022-7-5 19:11:17

真的

现在，我编写了一个测试代码，可以在您附带的绘图上使用

rmr jam · 发表于 2022-7-5 19:13:31

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

pBe · 发表于 2022-7-5 19:18:31

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

rmr jam · 发表于 2022-7-5 19:21:44

pBe,

That routine is so far beyond my understanding. Could you add some comments to it to describe what is going on there?

BIGAL · 发表于 2022-7-5 19:22:09

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.

BIGAL · 发表于 2022-7-5 19:28:11

I appreciate Pbe is working hard on a full answer, here is a method of finding objects inside a circle along the lines of the code you started to write which uses a more automated 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.

copy

; 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

copy

; 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)

pBe · 发表于 2022-7-5 19:31:04

copy

(defun c:fixmeplease (/ _inside-p  blocks 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 LAyForO  niladoc (vla-get-ActiveDocument (vlax-get-acad-object))blocks (vla-get-blocks adoc )space  (vla-get-modelspace aDoc))(vlax-for l (vla-get-layers  aDoc)  (if    (equal '(-1 0)    (mapcar '(lambda (v)        (vlax-get l v)      )     '("LayerOn" "Freeze")    )    )     (setq LAyForO (cons (vla-get-name l) LAyForO)     )  ))  (if (and [color="blue"](setq blkn         (cond ((tblsearch "BLOCK" "instrbub") "instrbub")              ((findfile "instrbub.dwg"))))[/color] (setq textcoll nil blkcoll nil       circoll  nil        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 txtent  nil      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))      )                   )      )  [color="blue"] (princ (cond     ((null blkn) "\n>")     ((null ss) "\n>")))[/color]   ) (princ)        )

[编程交流] 插入具有属性a的块

发表回复

精选推荐