社区 › Auto Lisp › 我想添加“居中对齐”

asami586 发表于 2022-7-5 16:48:33

我想添加“居中对齐”

你好我这里有一个Lisp程序的词，我用得很好。
此lisp具有中心对齐。
当我使用此选项时，此lisp会将选定对象的X值和Y值对齐。
但是
我只想按X值对齐对象。
能给我这个吗？
 
 
 
 
（定义c:AA（/ActDoc Sel AliObj AliLl AliUr ss AliOpt Ent tempObj templ tempUr）
 
（vl load com）
（setq ActDoc（vla get ActiveDocument（vlax get Acad Object）））
（vla ENDUDOMARK ActDoc）
（vla StartUndoMark ActDoc）
（如果
（和
（setq Sel（entsel“\n选择基础对象（用于对齐）：”）
（非（重画（汽车选择）3））
（setq AliObj（vlax ename->vla object（car Sel）））
（不是（vla GetBoundingBox AliObj'AliLl'AliUr））
（setq AliLl（安全数组值AliLl））
（setq AliUr（安全数组值AliUr））
（setq ss（ssget））
（不是（initget“Left Right Center Top Bottom”））
（setq AliOpt）
（如果（setq AliOpt（getkword）“\n对齐选项[中心/左/右/上/下]：
“”）AliOpt
“居中”
)
)
（setq cnt-1）
)
（而（setq Ent（ssname ss（setq cnt（1+cnt）））
（setq tempObj（vlax ename->vla object Ent））
（vla GetBoundingBox tempObj‘tempLl’tempUr）
（setq模板（安全数组值模板））
（setq tempUr（安全数组值tempUr））
（续）
（=AliOpt“中心”）
（vlax调用
坦波布
'移动
（mapcar’（λ（a b）（/（+a b）2.0））tempLl tempUr）
（mapcar’（λ（a b）（/（+a b）2.0））AliLl AliUr）
)
)
（=AliOpt“左”）
（vlax调用
坦波布
'移动
坦普尔
（列表
（汽车警报）
（cadr tempLl）
（caddr tempLl）
)
)
)
（=AliOpt“Right”）
（vlax调用
坦波布
'移动
坦普尔
（列表
（汽车校准）
（cadr tempUr）
（caddr tempUr）
)
)
)
（=AliOpt“顶部”）
（vlax调用
坦波布
'移动
坦普尔
（列表
（汽车温度）
（cadr AliUr）
（caddr tempUr）
)
)
)
（=AliOpt“底部”）
（vlax调用
坦波布
'移动
坦普尔
（列表
（汽车模板）
（卡德尔·阿利尔）
（caddr tempLl）
)
)
)
)
)
)
（如果选择（重画（汽车选择）4））
（vla ENDUDOMARK ActDoc）
（普林斯）
)
（提示“\n输入AO以启动。”）

asami586 发表于 2022-7-5 16:56:45

如果可以将对齐添加到lisp中，我想将其命名为“Middle（M）”。

tombu 发表于 2022-7-5 17:03:50

第一次包裹
tags around selected text using # from Toolbar above.<p>2ndPaste the link to where you got the lisp.It gives credit to the author and provides more information about the lisp.</p>

Grrr 发表于 2022-7-5 17:11:28

这是一个很好的代码，刚刚找到源线程，作者是蒂姆·威利。
 
无论如何，我的尝试如下：


; Align Objects with Justification
(defun C:test ( / m mv *error* Lst s SS c acDoc i o d Lst2 sBL sTR dBL dTR)

(defun m (p1 p2) (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.)) (list p1 p2))))
(defun mv (o p1 p2) (vlax-invoke o 'move p1 p2))
(defun *error* (m) (and acDoc (vla-EndUndoMark acDoc))(print m)(princ))
(setq Lst
   (list
   (cons "Left" '((d) (list (cadr d) (list (car (car s)) (cadr (cadr d)) (caddr (cadr d))))))
   (cons "Center" '((d) (list (cadddr d) (list (car (caddr s)) (cadr (cadddr d)) (caddr (cadddr d))))))
   (cons "Right" '((d) (list (caddr d) (list (car (cadr s)) (cadr (caddr d)) (caddr (caddr d))))))
   (cons "Top" '((d) (list (caddr d) (list (car (caddr d)) (cadr (cadr s)) (caddr (caddr d))))))
   (cons "Middle" '((d) (list (cadddr d) (list (car (cadddr d)) (cadr (caddr s)) (caddr (cadddr d))))))
   (cons "Bottom" '((d) (list (cadr d) (list (car (cadr d)) (cadr (car s)) (caddr (cadr d))))))
   )
)

(setvar 'errno 0)
(while (/= 52 (getvar 'errno))
   (setq s (car (entsel "\nSelect base object for aligning <exit>: ")))
   (cond
   ((= 7 (getvar 'errno)) (princ "\nMissed.") (setvar 'errno 0))
   (
       (and s
         (or
         (not (vlax-method-applicable-p (vlax-ename->vla-object s) 'GetBoundingBox))
         (vl-catch-all-error-p (vl-catch-all-apply 'vla-GetBoundingBox (list (vlax-ename->vla-object s) 'sBL 'sTR)))
         )
       )
       (princ "\nInvalid object.")
   )
   (s
       (and
         (setq s (mapcar 'safearray-value (list sBL sTR)))
         (setq s (append s (list (apply 'm s))))
         (princ "\nSelect objects to be aligned: ")
         (setq SS (ssget "_:L"))
         (not (initget (apply 'strcat (mapcar '(lambda (x) (strcat x " ")) (mapcar 'car Lst)))))
         (or
         (setq c
             (getkword
               (strcat
               "\nSpecify alignment option ["
               (vl-string-right-trim "/" (apply 'strcat (mapcar '(lambda (x) (strcat x "/")) (mapcar 'car Lst))))
               "]: <Center> "
               )
             )
         )
         (setq c "Center")
         )
         (progn
         (repeat (setq i (sslength SS))
             (and
               (vlax-method-applicable-p (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i))))) 'GetBoundingBox)
               (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-GetBoundingBox (list o 'dBL 'dTR))))
               (setq d (mapcar 'safearray-value (list dBL dTR))) ; o BL TR MC
               (setq d (append (list o) d (list (apply 'm d))))
               (setq Lst2 (cons d Lst2))
             ); and
         ); repeat
         (if Lst2
             (progn
               (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
               (or (/= 8 (logand (getvar 'undoctl) 8)) (not (vla-EndUndoMark acDoc)) )
               (not (vla-StartUndoMark acDoc))
               (mapcar '(lambda (x) (apply 'mv (append (list (car x)) ((cdr (assoc c Lst)) x)))) Lst2)
               (and (= 8 (logand (getvar 'undoctl) 8)) (vla-EndUndoMark acDoc))
             )
         )
         )
       ); and
       (setvar 'errno 52)
   )
   )
); while

(princ)
); defun

asami586 发表于 2022-7-5 17:22:23

非常感谢。下次我会遵守这里的规则

asami586 发表于 2022-7-5 17:27:35

吼叫声我真的很感激你所做的一切。
我可以请你再补充一件事吗？
我想添加“内部中心”，作为上一个LISP的“中心”。我希望“内部中心”将是默认选项。
ex）对齐选项[左/中/右/上/中/下/内中心]：
如果你有空闲时间，你能帮我吗？

Grrr 发表于 2022-7-5 17:36:37

对于“匹配中心”，将其包含在Lst变量中：
(cons "MatchCenter" '((d) (list (cadddr d) (caddr s))))

asami586 发表于 2022-7-5 17:46:45

这正是我想要的！
我真的非常感谢你这么做，Grrr
祝您有个美好的一天！

SLW210 发表于 2022-7-5 17:54:07

请阅读代码发布指南，并编辑代码以包含在代码标签中。
Your Code Here=
Your Code Here

查看完整版本: 我想添加“居中对齐”