社区 › AutoLISP/Visual LISP 编程技术 › 选中加外框，求大佬帮忙修改一下

soso 发表于 2024-5-9 13:50:22

选中加外框，求大佬帮忙修改一下

本帖最后由 soso 于 2024-5-9 16:47 编辑



(defun c:ww (/ *error* lst owners)
(vl-load-com)
(defun *error* ( msg )
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                        (princ (strcat "\n** Error: " msg " **")))
    (princ)
)
      (setq lst
                (vl-remove-if
                        (function
                              (lambda ( object )
                                        (vl-position object owners)
                              )
                        )
                        (LM:SS->VLA (ssget))
                )
      )
      (setq lst      (LM:BBox->List
                                                      (LM:ListBoundingBox lst)
                                                ))
      (command "RECTANG" "non" (car lst) "non" (caddr lst))
      (COMMAND "OFFSET""e""Y" "" "")
      (COMMAND "OFFSET""e""N" "" "")
      (princ)
)
(defun LM:ss->vla ( ss )
;; ?Lee Mac 2010
(if ss
    (
      (lambda ( i / e l )
      (while (setq e (ssname ss (setq i (1+ i))))
          (setq l (cons (vlax-ename->vla-object e) l))
      )
      l
      )
      -0
    )
)
)
(defun LM:ListBoundingBox ( lst / ll ur bb )
;; ?Lee Mac 2010
(foreach obj lst (vla-getBoundingBox obj 'll 'ur)
    (setq bb (cons (vlax-safearray->list ur)
                                                         (cons (vlax-safearray->list ll) bb))
    )
)
(mapcar
    (function
      (lambda ( operation )
      (apply (function mapcar) (cons operation bb))
      )
    )
                '(min max)
)
)
(defun LM:BBox->List ( bbox )
(mapcar
    (function
      (lambda ( funcs )
      (mapcar
          (function
            (lambda ( func ) ((eval func) bbox))
          )
          funcs
      )
      )
    )
    '((caarcadar)(caadr cadar) (caadr cadadr) (caarcadadr))
)
)



为啥右边会多一些   

soso 发表于 2024-8-23 10:35:52

本帖最后由 soso 于 2024-8-23 10:38 编辑

xyp1964 发表于 2024-8-23 00:04

命令: TT
选择对象: 指定对角点: 找到 0 个    （选择文字提示找不到）
选择对象:
命令:
命令: 指定对角点或 [栏选(F)/圈围(WP)/圈交(CP)]:
命令:
TT
找到 375 个                           
; 错误: no function definition: XYP-9PT
命令:
命令: TT
选择对象: 指定对角点: 找到 375 个（选择全部提示报错）
选择对象:
; 错误: no function definition: XYP-9PT


测试了不行

xyp1964 发表于 2024-8-23 00:04:06

(defun c:tt ()
(while (setq ss (ssget '((0 . "LWPOLYLINE,LINE"))))
    (setq s1 (xyp-Rectang (xyp-9pt ss 1) (xyp-9pt ss 9))
          s1 (xyp-SubUpd s1 62 1)
    )
)
(princ)
)

这只胆小鬼 发表于 2024-8-23 15:05:14

(LM:SS->VLA (ssget))这个改成(LM:SS->VLA (ssget '((0 . "LWPOLYLINE,LINE")))) 不要文字不就行了

start4444 发表于 2024-5-9 14:23:35

多数是多行字体的问题

soso 发表于 2024-5-9 17:37:13

start4444 发表于 2024-5-9 14:23
多数是多行字体的问题

:( 可以帮忙修改一下吗 大佬 每个都向右增加了一些

xyp1964 发表于 2024-5-9 22:13:47

里面的“综合整理”宽度超出了图框边界

xyp1964 发表于 2024-5-9 23:30:57

神经选择方框

soso 发表于 2024-5-12 19:10:40

来个大佬 帮忙修改一下

bonny 发表于 2024-5-13 00:40:01

本帖最后由 bonny 于 2024-5-13 00:44 编辑

特例特处理

清山小石 发表于 2024-5-24 10:47:27

bonny 发表于 2024-5-13 00:40
特例特处理

能加入图块的边界不？

soso 发表于 2024-8-22 21:00:58

bonny 发表于 2024-5-13 00:40
特例特处理

左边文字没法加 如果我把框删了 选择不会再把文字也计算进去:Q-

查看完整版本: 选中加外框，求大佬帮忙修改一下