按块替换圆
嗨，朋友们，是否有任何lisp以块替换选定的圆。。。。。。。。。。。。
请帮帮我
谢谢
马尼 试试看
;;; Command changes the set of primitives for the selected primitive.
;;; Examples:
;;; Replacement of some other blocks.
;;; Replacement blocks or dots circles.
;;; Replacement of some other titles.
;;;
;;; First you need to select a sample, and then specify replaceable objects.
;;; Box is in the center is restricted (bounding) rectangle of old objects.
;;; New objects are inserted into the layers that Belonged to which the old objects.
;;; Supports pre-selection.
(defun c:frto(/ ACTDOC COPOBJ ERRCOUNT EXTLST
EXTSET FROMCEN LAYCOL MAXPT CURLAY
MINPT OBJLAY OKCOUNT OLAYST
SCLAY TOCEN TOOBJ VLAOBJ *ERROR* ASK)
(vl-load-com)
(defun *ERROR*(msg)
(if olaySt (vla-put-Lock objLay olaySt)); end if
(vla-EndUndoMark actDoc)(princ)); end of *ERROR*
(defun GetBoundingCenter(vlaObj / blPt trPt cnPt)
(vla-GetBoundingBox vlaObj 'minPt 'maxPt)
(setq blPt(vlax-safearray->list minPt)
trPt(vlax-safearray->list maxPt)
cnPt(vlax-3D-point
(list
(+(car blPt)(/(-(car trPt)(car blPt))2))
(+(cadr blPt)(/(-(cadr trPt)(cadr blPt))2))
(+(caddr blPt)(/(-(caddr trPt)(caddr blPt))2)) ;_<<< Заменили
)))); end of GetBoundingCenter
(setq extSet(ssget "_I"))
(while (not (setq toObj(entsel "\n+++ Select source object (sample) -> ")))
(princ "\nSource objects isn't selected!"))
(if(not extSet)
(progn
(princ "\n+++ Select destination (replaceable) objects and press Enter <- ")
(setq extSet(ssget "_:L")))); end if
(if(not extSet)(princ "\nDestination objects isn't selected!")); end if
(if (and extSet toObj)
(progn
(initget "Yes No")
(setq ask (getkword "\nRemove destination object <No>:"))
(setq actDoc (vla-get-ActiveDocument(vlax-get-Acad-object))
layCol (vla-get-Layers actDoc)
extLst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp
(mapcar 'cadr(ssnamex extSet))))
vlaObj (vlax-ename->vla-object(car toObj))
objLay (vla-Item layCol (vla-get-Layer vlaObj))
olaySt (vla-get-Lock objLay)
fromCen (GetBoundingCenter vlaObj)
errCount 0okCount 0); end setq
(vla-StartUndoMark actDoc)
(foreach obj extLst
(setq toCen (GetBoundingCenter obj)
scLay (vla-Item layCol (vla-get-Layer obj)));end setq
(if(/= :vlax-true(vla-get-Lock scLay))
(progn
(setq curLay(vla-get-Layer obj))
(vla-put-Lock objLay :vlax-false)
(setq copObj(vla-copy vlaObj))
(vla-Move copObj fromCen toCen)
(_kpblc-ent-properties-copy obj copObj)
(vla-put-Layer copObj curLay)
(vla-put-Lock objLay olaySt)
(if (= ask "Yes")(vla-Delete obj))
(setq okCount(1+ okCount))
); end progn
(setq errCount(1+ errCount))
); end if
); end foreach
(princ (strcat "\n" (itoa okCount) " were changed. "
(if(/= 0 errCount)(strcat (itoa errCount) " were on locked layer! ")"")))
(vla-EndUndoMark actDoc)); end progn
(princ "\nSource object isn't selected! ")
); end if
(princ)); end of c:frto
(defun _kpblc-ent-properties-copy (source dest)
(foreach prop '("Angle" "Layer" "Linetype" "LinetypeScale" "Lineweight"
"Normal" "PlotStyleName" "Thickness" "Color" "Visible"
"Closed" ;|"ConstantWidth" ; не копируется|; "Elevation" "LinetypeGeneration"
"LinetypeScale" ;|"StartAngle" "EndAngle" ; не копируются|; "Alignment"
"Backward" "Height" "ObliqueAngle" "Rotation" "ScaleFactor" "StyleName"
"TextGenerationFlag""TextHeight""UpsideDown""AttachmentPoint" "BackgroundFill"
"DrawingDirection""LineSpacingDistance" "LineSpacingFactor" "LineSpacingStyle""Width"
"XScaleFactor" "YScaleFactor" "ZScaleFactor" ;| Viewport|; "ArcSmoothness" "CustomScale"
"Direction" "DisplayLocked""GridOn" "LensLength" "ModelView" "ShadePlot" "SheetView"
"SnapBasePoint" "SnapOn" "SnapRotationAngle" "StandardScale" "Target""TwistAngle"
"UCSIconAtOrigin" "UCSIconOn" "UCSPerViewport" "ViewportOn")
(if (and (vlax-property-available-p source prop)(vlax-property-available-p dest prop t))
(vl-catch-all-apply
'(lambda ()(vlax-put-property dest prop (vlax-get-property source prop))))
)
)
)
谢谢VVA和李
这两种代码都运行良好。。。。。这对我有很大帮助。。。。。。。。。
谢谢你
当做
马尼语：）：） 不客气，兄弟 嗨，李，
只是想知道你会如何改变它来取代甜甜圈？
我试图修改代码，但无法使其正常工作。
谢谢
史蒂夫 甜甜圈不是一种实体；“圆环”命令将生成由两条圆弧组成的粗多段线。所以，你需要设计一个算法来识别它们。必须验证圆弧是否共享同一中心点，是否在端点处连接，其内角是否为180度（DXF代码42设置为1.0-这也确保了圆弧的解析意义相同，因此不重合）。 你可以通过Express Tools-overkill将甜甜圈变为圆形。
然后运行李的代码。
或者试试这个来代替甜甜圈：
(defun c:cir2ins ( / blk ss )
;; © Lee Mac 2010
(if
(and
(setq blk
(LM:SelectifFoo
(lambda ( x )
(and (eq "INSERT" (cdr (assoc 0 (entget x))))
(zerop
(logand (+ 1 4)
(cdr
(assoc 70
(tblsearch "BLOCK"
(cdr
(assoc 2
(entget x)
)
)
)
)
)
)
)
)
)
"\nSelect Block: "
)
)
(setq ss (ssget "_:L" '((0 . "CIRCLE"))))
)
(
(lambda ( i / e )
(while (setq e (ssname ss (setq i (1+ i))))
(if
(entmakex
(append
(list
(cons 0 "INSERT")
(assoc 2 (entget blk))
)
(LM:RemovePairs '(0 100 40) (entget e))
)
)
(entdel e)
)
)
)
-1
)
)
(princ)
)
(defun LM:SelectifFoo ( foo str / sel ent )
(vl-load-com)
;; © Lee Mac 2010
(while
(progn
(setq sel (entsel str))
(cond
(
(vl-consp sel)
(if (not (foo (setq ent (car sel))))
(princ "\n** Invalid Object Selected **")
)
)
)
)
)
ent
)
(defun LM:RemovePairs ( pairs lst )
(vl-load-com)
;; © Lee Mac 2010
(vl-remove-if
(function
(lambda ( pair )
(vl-position (car pair) pairs)
)
)
lst
)
)
非常感谢Stefan，太棒了！
干杯
史蒂夫 不客气，史蒂夫。我很高兴你喜欢它。 大家好，
我是这个论坛的新手。我一直在寻找一个lisp例程，该例程可以选择任何层上特定直径（不是范围或大于/小于场景）的所有圆，并用块引用替换它们，然后删除原始圆。李的代码工作得很好，但我想做一个批量选择和替换，而不是选择每个单独的圈被替换。一个计数器来显示被替换了多少个圆圈是有益的，但这不是必要的。有人能帮我吗？
页:
[1]
2