RT【已解决】

lslsq · 发表于 2021-2-25 16:37:30

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 lslsq 于 2021-2-25 18:23 编辑

;;选定区域内指定图块("DC-DS-16" "DC-SW-M8" "DC-陶瓷头-unlogo" "DC-DS-29" "VC451" "VC551" "VC651" "VC751" "VC851")
;;分类创建块
(defun c:imf(/ i mold:h:ss oldcmdecho oldosmode pt ss str)
(command "undo" "be" )
(setq oldcmdecho (getvar "cmdecho" )
oldosmode (getvar "osmode")
)
(while(null(setq Mold:H:SS (ssget))))
(setq pt (LM:ssboundingbox Mold:H:SS ))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(SETQ I 0)
(foreach n '("DC-DS-16" "DC-SW-M8" "DC-陶瓷头-unlogo" "DC-DS-29" "VC451" "VC551" "VC651" "VC751" "VC851")
(progn
(setq SS (ssget "C" (trans (CAR pt) 0 1) (trans (CADR pt) 0 1) (list (CONS 0 "INSERT") (CONS 2 n))))
(setQ STR (strcat (rtos (* (getvar "cdate") 1000000) 2 0)(itoa I)) )
(setq i (+ 1 i))
(IF (/= SS NIL )
(progn
(IF (vl-cmdf "_block" STR '( 0.0 0.0 0.0 ) SS "")
(IF(vl-cmdf "_insert" STR '( 0.0 0.0 0.0 ) "" "" "" )
(prompt (strcat n "块创建完成"))
)
)
(SETQ SS NIL)
)
) ;end if
)
) ;end foreach
(setvar "cmdecho" oldcmdecho)
(setvar "osmode" oldosmode)
(command "undo" "e" )
(princ)
)
;; 选择集边界框-Lee Mac
;; 返回的左下和右上WCS坐标的列表。矩形框，该矩形框限制了提供的选择集中的所有对象。
;; SEL - [SEL]选择集为其返回边界框
(defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
(repeat (setq idx (sslength sel))
(setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
(if (and (vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
)
(setq ls1 (cons (vlax-safearray->list llp) ls1)
ls2 (cons (vlax-safearray->list urp) ls2)
)
)
)
(if (and ls1 ls2)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)
)

;;选定区域内指定图块("DC-DS-16" "DC-SW-M8" "DC-陶瓷头-unlogo" "DC-DS-29" "VC451"  "VC551" "VC651" "VC751" "VC851") 
;;分类创建块 
(defun c:imf(/ i mold:h:ss oldcmdecho oldosmode pt ss str) 
  (command "undo" "be" ) 
  (setq oldcmdecho (getvar "cmdecho" ) 
    oldosmode (getvar "osmode") 
  ) 
  (while(null(setq Mold:H:SS (ssget)))) 
  (setq pt (LM:ssboundingbox Mold:H:SS )) 
  (setvar "cmdecho" 0) 
  (setvar "osmode" 0) 
  (SETQ I 0) 
  (foreach n '("DC-DS-16" "DC-SW-M8" "DC-陶瓷头-unlogo" "DC-DS-29" "VC451"  "VC551" "VC651" "VC751" "VC851") 
    (progn 
      (setq SS (ssget "C"  (trans (CAR pt)  0 1) (trans (CADR pt)  0 1) (list (CONS 0  "INSERT") (CONS 2  n)))) 
      (setQ STR (strcat (rtos (* (getvar "cdate") 1000000) 2 0)(itoa I)) ) 
      (setq i (+ 1 i)) 
      (IF (/= SS NIL ) 
        (progn 
          (IF (vl-cmdf "_block" STR  '( 0.0  0.0  0.0 )  SS "") 
            (IF(vl-cmdf "_insert" STR '( 0.0  0.0  0.0 ) "" "" "" ) 
              (prompt (strcat n "块创建完成")) 
            ) 
          ) 
          (SETQ SS NIL) 
        ) 
      ) ;end if 
    ) 
  ) ;end foreach 
  (setvar "cmdecho" oldcmdecho) 
  (setvar "osmode" oldosmode) 
  (command "undo" "e" ) 
  (princ) 
) 
;; 选择集边界框-Lee Mac 
;; 返回的左下和右上WCS坐标的列表。矩形框，该矩形框限制了提供的选择集中的所有对象。 
;; SEL - [SEL]选择集为其返回边界框 
(defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp ) 
  (repeat (setq idx (sslength sel)) 
    (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))) 
    (if (and (vlax-method-applicable-p obj 'getboundingbox) 
          (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp)))) 
        ) 
      (setq ls1 (cons (vlax-safearray->list llp) ls1) 
        ls2 (cons (vlax-safearray->list urp) ls2) 
      ) 
    ) 
  ) 
  (if (and ls1 ls2) 
    (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2)) 
  ) 
)

lslsq · 发表于 2021-2-25 16:40:37

本帖最后由 lslsq 于 2021-2-25 18:22 编辑

已解决，(rtos (* (getvar "cdate") 1000000) 2 0)
运行过程中块名字一样导致的加个递增就好了

SHUNDocker · 发表于 2021-2-26 09:51:51

感谢楼主分享学习！！

账号		自动登录	找回密码
密码			立即注册

[求助] RT【已解决】

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。