社区 › Auto Lisp › 将点转换为对象

rusty 发表于 2022-7-6 17:13:07

将点转换为对象

嗨，我在画地质图。我有386个点，我希望用菱形多边形来代替。有什么办法我可以很快做到吗？
 
我画了一个菱形的多边形，我现在想知道是否有任何可用的自动替换命令。我应该把多边形转换成块吗？
 
非常感谢您的帮助，因为我不太喜欢手动操作

ASMI 发表于 2022-7-6 17:47:52

试试这个。首先选择点，然后拾取多边形。
 
(defun c:frt(/ actDoc copObj errCount extLst
            extSet fromCen layCol maxPt curLay
            minPt ObjLay okCount oLayst answ
            scLay toCen toObj vlaObj *error*)

(vl-load-com)

(defun *error*(msg)
   (if olaySt
   (progn
       (vla-put-Lock objLay olaySt)
       (vla-EndUndoMark actDoc)
   ); end progn
   ); end if
   (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))
      0.0
         ); end list
    ); end vlax-3D-point
   ); end setq
); end of GetBoundingCenter

(if(not(setq extSet(ssget "_I")))
   (progn
   (princ "\n>>> Select replaced objects <<< ")
   (setq extSet(ssget))
   ); end progn
   ); end if
(if(not extSet)
   (princ "\nReplaced objects isn't selected!")
   ); end if
(if
   (and extSet
   (setq toObj(entsel "\n>>> Pick replacing object -> "))
   ); and and
   (progn
   (initget 1 "Yes No")
   (setq answ(getkword "\nErase replaced objects : ")
    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 0
         okCount 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)
        (vla-put-Layer copObj curLay)
        (vla-put-Lock objLay olaySt)
        (if(= "Yes" answ)
          (vla-Delete obj)
        );end if
        (setq okCount(1+ okCount))
      ); end progn
       (setq errCount(1+ errCount))
    ); end if
); end foreach
   (princ
(strcat "\n" (itoa okCount) " were replaced. "
   (if(/= 0 errCount)
   (strcat (itoa errCount) " were on locked layer! ")
   ""
   ); end if
   ); end strcat
); end princ
   (vla-EndUndoMark actDoc)
   ); end progn
   (princ "\nReplacing object isn't selected! ")
   ); end if
(princ)
); end of c:frt

hotrodz0321 发表于 2022-7-6 18:07:11

我们在谈论什么样的观点？autocad点？

fuccaro 发表于 2022-7-6 18:25:04

只是为了子孙后代：这条线与这条线相连：http://www.cadtutor.net/forum/showthread.php?t=28876
我们不能因为多次发帖而责怪鲁斯蒂。

查看完整版本: 将点转换为对象