ABBS 论坛       
首页Master作品招聘招标动态热帖杂志招聘帮助搜索注册登录Blog  积分 简历  

» ABBS 论坛 » CAD应用与开发 » 一般应用  

动态热帖招聘杂志 
   
reply to topic
threaded modego to previous topicgo to next topic
请高手帮忙 关于晓东尺寸标注线,界线伸缩 LSP
踢开地球


发贴: 3



2011-11-21 17:23 查看他的注册信息   查看他的Blog 给他发送悄悄话 引用并回帖 搜索他发表的帖子 复制到剪贴板. 
不过只适用于IE 收藏这篇帖子
请高手帮忙 关于晓东尺寸标注线,界线伸缩 LSP 能不能修改下可以支持高版本CAD

命令:XDTB_DimExtend
功能:尺寸标注线,界线伸缩
|;
(defun c:XDTB_DimExtend (/ destPoint ss e clna sPoint sPt1 sPt2 ang sInt
       nearPt pos tf
      )
(xdrx_SysVar_Push "osmode")
(setvar "osmode" 3063)
(if (not $XDTB_DimXExtend_Op)
(setq $XDTB_DimXExtend_Op "V")
)
(setq tf t)
(while tf
(prompt (strcat "\n当前操作:" (cond
         ((= "V" $XDTB_DimXExtend_Op)
         "界线纵移"
         )
         ((= "H" $XDTB_DimXExtend_Op)
         "界线平移"
         )
         (T
         "尺寸线纵移"
         )
         )
   )
)
(initget "V H B")
(setq destPoint (xdrx_GetPoint "\n请点取目标点[界线纵移-V/ 界线平移-H / 尺寸线纵移-B]<退出>:"))
(cond
((= destPoint "V")
  (setq $XDTB_DimXExtend_Op "V")
)
((= destPoint "H")
  (setq $XDTB_DimXExtend_Op "H")
)
((= destPoint "B")
  (setq $XDTB_DimXExtend_Op "B")
)
((car destPoint)
  (setq tf nil)
)
(t
  (exit)
)
)
)
(xdrx_begin)
(while (progn
   (prompt "\r请选取要伸缩尺寸标注<退出>:")
   (setq ss (ssget '((0 . "DIMENSION"))))
   )
(setq destPoint (trans destPoint 1 0))
(xdrx_SetSSToDb ss 0)
(while (setq e (xdrx_GetEntData 0))
(setq clna (last (xdrx_Object_ClassName e)))
(if (wcmatch clna "AcDbRotatedDimension,AcDbAlignedDimension")
  (progn
   (setq sPoint (xdrx_Entity_GetStretchPoint e))
   (setq sPt1 (car sPoint)
    sPt2 (cadr sPoint)
    ang (xdrx_GetEntDxf 50)
   )
   (if (= $XDTB_DimXExtend_Op "H")
   (progn
   (setq sInt (inters
       sPt1
       sPt2
       destPoint
       (polar destPoint (+ ang _pi2) 100)
       nil
       )
     nearPt (car (xdrx_GetNearPt sInt sPt1 sPt2))
     pos (- (length sPoint) (length (member nearPt sPoint)))
   )
   (xdrx_Entity_MoveStretchPoint e (mapcar
            '-
            sInt
            nearPt
           ) pos
   )
   )
   (progn
   (setq sInt (mapcar
       '(lambda (x)
       (inters
        x
        (polar x (+ ang _pi2) 100)
        destPoint
        (polar destPoint ang 100)
        nil
       )
       )
       (list sPt1 sPt2 (caddr sPoint))
       )
   )
   (if (= $XDTB_DimXExtend_Op "V")
    (progn
     (xdrx_Entity_MoveStretchPoint e (mapcar
             '-
             (car sInt)
             sPt1
             ) 0
     )
     (xdrx_Entity_MoveStretchPoint e (mapcar
             '-
             (cadr sInt)
             sPt2
             ) 1
     )
    )
    (progn
     (xdrx_Entity_MoveStretchPoint e (mapcar
             '-
             (last sInt)
             (caddr sPoint)
             ) 2
     )
    )
   )
   )
   )
  )
)
)
)
(xdrx_end)
(xdrx_SysVar_Pop)
(princ)
)





已读帖子
新的帖子
被删帖子

reply to topic
Jump to the top of page

返回ABBS首页 | 设计 | 室内 | 景观 | 建材 | 设备 | 卫浴 | 展览 | 照明

广告服务 | 招聘服务 | 隐私政策 | 联系我们 | 设为首页

违法、有害信息举报:QQ 1764506 电话 028-61998486
Powered by Jute Powerful Forum® Version Jute 1.5.5 Ent
Copyright © 1998-2022 ABBS.com All Rights Reserved.