guangdonglbq 发表于 2020-9-27 23:44:22

标注增强倾斜

本帖最后由 guangdonglbq 于 2020-9-27 23:45 编辑

使用autocad自带的倾斜功能时，标尺界线会倾斜显示，但标注文本始终垂直于尺寸线，整体看起来不是那么协调。使用本程序可使尺寸界线倾斜时，标注文本也倾斜相同角度。
易桥工具箱中的标注“增强倾斜”的功能，使用效果与本程序相同。

;;;标注增强倾斜
(defun DimensionEnhanceTilt(/ entdxf fbasiclineangle fjiajiao foutangle ftargetangle listdirectionpoint1 listdirectionpoint2 listfirstpoint listsecondpoint objectnth ssobjects strobjectname stroutangle)
;(BeginUndoGroup)
      (princ "\n选择对齐尺寸标注:")
      (while (setq ssObjects (ssget '((0 . "DIMENSION")))) ; 创建选择集 ssObjects
                (setq listDirectionPoint1 (getpoint "点取倾斜方向上的第一点："))
                (setq listDirectionPoint2 (getpointlistDirectionPoint1 "\n点取倾斜方向上的第二点："))
                (setq fTargetAngle (angle listDirectionPoint1 listDirectionPoint2 ))
                (command "_.DIMEDIT" "O" ssObjects "" listDirectionPoint1 listDirectionPoint2 )
               
    (setq ObjectNth 0)
    (while (< ObjectNth (sslength ssObjects))
                        (setq strObjectName (ssname ssObjects ObjectNth))
                        (setq entDxf (entget strObjectName))
                        
                        (setq      listFirstPoint (cdr (assoc 13 entDxf)))
                        (setq      listSecondPoint (cdr (assoc 14 entDxf))      )
                        (setq fBasicLineAngle (angle listSecondPoint listFirstPoint ))
                        
      (setq entDxf (entget strObjectName))
                        (setq fJiaJiao (- fBasicLineAngle fTargetAngle))
                        
                        (setq fOutAngle (- (RadToDegree fJiaJiao ) 90.0 ))      
                        
                        (if (> foutangle 180)
                              (setq foutangle (- foutangle 180))
                        )                        
                        (if (< foutangle -180 )
                              (setq foutangle (+ 180 foutangle)))
                        (if (< foutangle -90 )
                              (setq foutangle (+ 180 foutangle)))
                        ;;以上三句if语句可保证文字倾斜后，不出现错误，但未搞清楚不处理时的出错原因。
                        
                        (setq strOutAngle (strcat "{\\Q" (rtos fOutAngle 2 4) ";<>}" )) ;文字倾斜组码(1 . {\\Q16;<>})
                        
                        (entmod (subst (cons 1 strOutAngle)
                                                                (assoc 1 entDxf)
                                                                entDxf
                                                      )
                        )
                        (entupd strObjectName)
                        
                        (setq ObjectNth (1+ ObjectNth))
    )
               
    (princ "\n选择对齐尺寸标注:")
      )
;(EndUndoGroup)      
(princ)
)

;;弧度转为角度
(defun RadToDegree(rad)
(/ (* rad 180.0) pi)
)





mokson 发表于 2020-9-28 08:14:46

本帖最后由 mokson 于 2020-9-28 08:20 编辑

楼主大人辛苦了。感谢您！
但是如何使用，命令是什么？ RADTODEGREE？

xj6019 发表于 2020-9-28 08:58:50

不错，不错，严重支持.............:lol

yoyoho 发表于 2020-9-28 23:29:29

谢谢!guangdonglbq分享程序!!!!!

guangdonglbq 发表于 2020-9-29 15:45:10

mokson 发表于 2020-9-28 08:14
楼主大人辛苦了。感谢您！
但是如何使用，命令是什么？ RADTODEGREE？

(DimensionEnhanceTilt)

mokson 发表于 2020-9-29 17:40:42

命令搞得太长了。

czb203 发表于 2020-9-29 18:13:37

不错，不错，严重支持........

panliang9 发表于 2023-12-18 15:59:24

今天发现这个很好用！

林小林子 发表于 2024-5-16 10:15:25

这个很好

yk1216 发表于 2024-5-16 21:57:54

谢谢楼主分享
页: [1] 2
查看完整版本: 标注增强倾斜