标注比例对齐修改求助

YUYUFENG

各位彦祖大帅比，请帮帮忙。
想整个标注比例对齐的玩意，用了论坛里的代码修改后，发现好像无法获取修改后的比例文本的坐标，比例文本对齐的位置各种飘，请大佬们帮忙看看怎么回事？

以下是代码：

• 
  
  • ;;标注比例对齐
  • (defun c:qd (/ box ent ent1 p p1 p2 p1x p1y p2x p2y px py x1 y1 ss1 ss2 en en1 q qx qy )
  •   (princ "\n★功能：标注比例对齐\n")  
  •   (setq ent1 (car (entsel "\n选择标题文本：")))
  •   (command ".UNDO" "BE")               ; 设置undo起点
  •   
  •   (Defun OSmode (Value)
  •    (if Value
  •     (Setvar "osmode" (rem (Getvar "osmode") 16384))
  •     (Setvar "osmode" (+ (rem (Getvar "osmode") 16384) 16384))
  •    )
  •   )
  •   (OSmode nil);捕捉关
  •   
  •   (setq ent (entget ent1))
  •   (setq p (cdr (assoc 10 ent)))          ; 文本基点坐标
  •   (setq box (textbox ent))               ; 文本框坐标
  •   (setq p1x (car (car box))              ; 文本左下角X坐标
  •         p1y (car (cdr (car box)))
  •         p2x (car (car (cdr box)))        ; 文本右上角X坐标
  •         p2y (car (cdr (car (cdr box))))
  •         px (car p)
  •         py (car (cdr p))
  •   )                                       
  • (setq x1 (+ p2x (+ px 2.5)))
  • (setq y1 (- py 2.375))
  • (setq p2 (list x1 y1))                  ;计算标注比例插入坐标
  •   
  •   (princ)  
  •   
  •   
  •   (setq ss1 (ssget (list (cons 0 "*text")))  ;修改标注比例样式
  •         index 0
  •   )
  •       (initget 128)
  •       (setq newht 3.5)
  •       (setq newstyle "FSD")
  •       
  •   (if (setq styledata (tblsearch "style" newstyle))
  •     (progn
  •        (setq defwidth (cdr (assoc 41 styledata)))
  •        (while (setq ename (ssname ss1 index))
  •               (setq txtobj (vlax-ename->vla-object ename))
  •               (vlax-put-property txtobj 'Height newht)
  •               (vlax-put-property txtobj 'StyleName newstyle)
  •               (if (vlax-property-available-p txtobj 'ScaleFactor)
  •                   (vlax-put-property txtobj 'ScaleFactor defwidth)
  •               )
  •               (setq index (1+ index))
  •        )
  •     )
  •     (princ "\n文字型式不存在")
  •   )
  •   
  •   (command "justifytext" ss1 "" "L")        ;文字左对齐
  •   (command "change" ss1 "" "p" "c" "7" "")  ;文字白色  
  •   
  •   
  •   (while (> (getvar "CMDACTIVE") 0)        
  •          (command PAUSE)   
  •   )
  •   (setq ss2(entlast))                       ; 定义修改后比例文本
  •   
  •   (setq en (entget ss2))
  •   (setq q (cdr (assoc 10 en)))              ; 获取修改后比例文本基点坐标
  •   
  •     (setq qx (car q)
  •           qy (car (cdr q))
  •     )  
  •   
  • (setq p1 (list qx qy))
  •   
  •   (command "move" ss1 "" p1 p2)             ; 移动对齐修改后比例文本
  •   (OSmode t)  ;捕捉开
  •   
  • (princ)
  • )
    

liuhe

vla-GetBoundingBox   用这个函数试试，我用这个函数给标题加下划线 挺好用。


;;;从AutoCAD 2013 Active Reference帮助中code Examples中提取  
;;;本源代码由 xshrimp 2013.2.20 搜集整理,版权归原作者所有！  
  
  
(vl-load-com)  
(defun c:Example_GetBoundingBox()  
    ;; This example creates a line in model space. It then finds the  
    ;; bounding box for the line and displays the corners of the box.  
    (setq acadObj (vlax-get-acad-object))  
    (setq doc (vla-get-ActiveDocument acadObj))  
     
    ;; Create the Line object in model space  
    (setq startPoint (vlax-3D-point 2 2 0))  
    (setq endPoint (vlax-3D-point 4 4 0))  
    (setq modelSpace (vla-get-ModelSpace doc))  
    (setq lineObj (vla-AddLine modelSpace startPoint endPoint))  
    (vla-ZoomAll acadObj)  
      
    ;; Return the bounding box for the line and return the minimum  
    ;; and maximum extents of the box in the minExt and maxExt variables.  
    (vla-GetBoundingBox lineObj 'minExt 'maxExt)  
    (setq minExt (vlax-safearray->list minExt)  
      maxExt (vlax-safearray->list maxExt))  
     
    ;; Print the min and max extents  
    (alert (strcat "The extents of the bounding box for the line are:"  
                   "\nMin Extent: " (rtos (nth 0 minExt) 2) "," (rtos (nth 1 minExt) 2) "," (rtos (nth 2 minExt) 2)  
                   "\nMax Extent: " (rtos (nth 0 maxExt) 2) "," (rtos (nth 1 maxExt) 2) "," (rtos (nth 2 maxExt) 2)))  
)  

YUYUFENG

liuhe  2022-11-16 11:28
vla-GetBoundingBox    á