结构CAD

第一次做lisp，各位高手给小弟多提宝贵意见。。

直接上原码

根据吴所提的两点：1、标注文字距离适当加大了
2、原对齐标注，改成转角标注

发现在判断最佳标注点时，由于精度，现做优化，（想把部分代码贴到回帖里，超长，只能这里更新了）
已做了修改，最新代码见下：

发现bug，局部代码做修改。。。

;;;------------主函数c:zbz---------------------------------------------;;;
;;;----根据pl线及轴线的对方形柱进行定位标注----------------------------;;;
;;;----对标注值取整（精确到5），只实现了本标注的向外避让---------------;;;
;;;----目前自动根据图形最小尺度判断绘图比例，大于50则为1：1， ;;;
;;; 程序中参数仅适用于1:1,1:100的图 ;;;
;;; 对于特大天然地基，单边到轴线距离大于5米的将会按1：1处理-----;;;

(princ
"\n\n注意事项:1、轴线须为直线，曲线系列尚未完善；
\n 2、被标注对象须是矩形pl线(柱、独立基础、承台)，其他多边形尚未完善；
\n 3、可自动根据绘图比例设置参数，仅限1:1，1:00
\n---命令:zbz 对矩形pl线根据轴线进行标注---ps:首次使用请按F2，看注意事项"
)

(defun c:zbz (/ zxlayer ss sspline sszx i en)
(setq zxlayer (gt:getlayer))
(princ " 若轴线选择错误，请按ESC，重新执行命令")
(princ "\n-------选择需要标注的对象及所用的轴网-------:")
(setq  ss  (ssget)
  sspline  (ssadd)
  sszx  (ssadd)
)

;;建立标注所在的图层“定位标注”
(setq old_lay (getvar "clayer"))
(if (= (tblobjname "LAYER" "定位标注") nil)
(progn
(entmake (list
    '(0 . "LAYER")
    '(100 . "AcDbSymbolTableRecord")
    '(100 . "AcDbLayerTableRecord")
    '(6 . "CONTINUOUS")
    '(62 . 3)
    '(70 . 0)
    (cons 2 "定位标注")
   )
)
)
)
(setvar "clayer" "定位标注")

(setq i -1)
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i))))
(if  (= (cdr (assoc 8 (entget en))) zxlayer)
(ssadd en sszx)
)
(if  (and (= (cdr (assoc 0 (entget en))) "LWPOLYLINE") (>= (cdr (assoc 90 (entget en))) 4))
(ssadd en sspline)
)
)
(setq interss (getinter (gt:ttt sszx)));获取所有轴线交点坐标
(gt:tt sspline) ;对柱进行两边标注
)

;;;------------次函数gt:getlayer---------------------------;;;
;;;----------获取点选元素所在的图层并返回图层名称----------;;;
(defun gt:getlayer (/ zx layer)
(setq zx nil)
(while (= zx nil)
(setq zx (entsel "\n选择轴线图层:"))
)
(setq  layer
   (cdr (assoc 8 (entget (car zx))))
)
(setq zx nil)
(princ "\n选中的轴线图层是:")
(prin1 layer)
)

;;;-------获得传递来的四边形集合然后对两边进行标注-------------;;;
(defun gt:tt (sspline / OLDOS ss i en ptl p1 p2 p3 p4 p0 pp pz)
(setvar "CMDECHO" 0)
(setq OLDOS (getvar "OSMODE"))
(if (setq SS sspline)
(progn
(setvar "OSMODE" 0)
(setq i -1)
(repeat (sslength ss)
  (setq en (ssname ss (setq i (+ 1 i))))
  (setq ptl (getpline en)
   p1 (car ptl)
   p2 (cadr ptl)
   p3 (caddr ptl)
   p4 (cadddr ptl)
  )
  ;插入轴线交点集合，查找适合的点
(setq x -1)
  (repeat (length interss)
   (setq pp (nth (setq x (+ 1 x)) interss))
   (if (< (max(distance pp p1)(distance pp p2)(distance pp p3)(distance pp p4)) (distance p1 p3))
   (setq p0 pp)
   )
  )
  ;若柱内有交点则进行标注
  (if p0
   (progn
   (setq pz (getpz p1 p2 p3 p4))
   ;;根据最佳点位进行标注
   (if  (= pz p1)
   (progn
    (bz:dimaligned p4 p1 p2 p0)
    (bz:dimaligned p1 p2 p3 p0)
   )
   )
   (if  (= pz p2)
   (progn
    (bz:dimaligned p1 p2 p3 p0)
    (bz:dimaligned p2 p3 p4 p0)
   )
   )
   (if  (= pz p3)
   (progn
    (bz:dimaligned p2 p3 p4 p0)
    (bz:dimaligned p3 p4 p1 p0)
   )
   )
   (if  (= pz p4)
   (progn
    (bz:dimaligned p3 p4 p1 p0)
    (bz:dimaligned p4 p1 p2 p0)
   )
   )
   )
  )
)
)
)
(setvar "OSMODE" OLDOS)
(setvar "CMDECHO" 1)
(princ)
)

;;;----------次函数getpz:根据四点，求出最佳标注点----------;;;
(defun getpz (p1 p2 p3 p4 / pp1 pp2 pp3 pp4 ppz1 ppz2 ppz ppp1 ppp2 pp1y pp2y pp3y pp4y)
(setq  pp1 p1
  pp2 p2
  pp3 p3
  pp4 p4
  pp1y (atoi (rtos (*(nth 1 pp1) 100) 2 0))
  pp2y (atoi (rtos (*(nth 1 pp2) 100) 2 0))
  pp3y (atoi (rtos (*(nth 1 pp3) 100) 2 0))
  pp4y (atoi (rtos (*(nth 1 pp4) 100) 2 0))
)

;;求最高点
(if (> pp1y (max pp2y pp3y pp4y))
(setq ppz pp1)
)
(if (> pp2y (max pp1y pp3y pp4y))
(setq ppz pp2)
)
(if (> pp3y (max pp2y pp1y pp4y))
(setq ppz pp3)
)
(if (> pp4y (max pp2y pp3y pp1y))
(setq ppz pp4)
)
;;若是水平的柱，则求左上角点
(if (= ppz nil)
(progn (if (= pp1y (max pp2y pp3y pp4y))
   (setq ppp1 pp1)
   )
   (if (= pp2y (max pp1y pp3y pp4y))
   (if (= ppp1 nil) (setq ppp1 pp2) (setq ppp2 pp2))
   )
   (if (= pp3y (max pp2y pp1y pp4y))
   (if (= ppp1 nil) (setq ppp1 pp3) (setq ppp2 pp3))
   )
   (if (= pp4y (max pp2y pp3y pp1y))
   (if (= ppp1 nil) (setq ppp1 pp4) (setq ppp2 pp4))
   )
(setq ppz (if (< (nth 0 ppp1)(nth 0 ppp2)) ppp1 ppp2))
)
)
(if ppz ppz)
)

;;; 函数 bz:dimaligned 用来实现单边的两个标注 ;;;
(defun bz:dimaligned (p1 p2 p3 p0 / point1 point2 point3 point0 p12 angle32)
(setq  point1 p1
  point2 p2
  point3 p3
  point0 p0
  p12 (findper p0 p1 p2)
  angle32 (angle point3 point2)
)
(brbz point1 p12 angle32)
(brbz point2 p12 angle32)
)

;;;次函数dxf
(defun dxf (en dxf)
(cdr(assoc dxf (entget en)))
)

;;;次函数brbz，根据point1 point2 angle32进行避让标注
(defun brbz(point1 point2 angle32 / e0 p0 e w ed)
(setq distance12 (distance point1 point2))
(command "dimlinear"
   point1
   point2
   "t"
   ;;下面if语句是对标注值进行取整
   (if (< (ABS(- (* (atoi (rtos (if (> distance12 50)
          (/ distance12 5)
         (* distance12 20)
         )
         2 0
       )
     )
     5
     )
    
     (if (> distance12 50)
       distance12
     (* distance12 100)
     )
   )) 0.5)
   "<>"
   (*  (atoi (rtos (if  (> distance12 50)
       (/ distance12 5)
       (* distance12 20)
       )
       2
       0
     )
    )
    5
   )
   );end if
   "r"
   (* (/ angle32 pi) 180.0)
   (polar point1 angle32 (if (> distance12 50) 800 8 ))
);end command

;;获取最近画的标注，判断是否需要避让
(setq e0 (entlast)
  p0 (dxf e0 11)
e (cdr (assoc -2 (tblsearch "block" (dxf e0 2))))
)
(while e
(if (= (dxf e 0) "MTEXT")
  (setq w  (dxf e 42)
   e  nil
  )
  (setq e (entnext e))
)
)
;;根据条件进行避让
(if (> w (- distance12 1))
(progn
(setq ed (entget e0); 图元名e0的数据关联表存ed
ed (subst (cons 11
       (polar(polar p0
         (angle point2 point1)
         (if  (> distance12 50) 350 3.5)
       )
         angle32 (if  (> distance12 50) 100 1)
       )

     )
     (assoc 11 ed)
     ed
    ); ; ; 更改11
ed (subst (cons 70 (logior (cdr (assoc 70 ed)) 128))(assoc 70 ed)ed); ; ; 更改70
)
(entmod ed)
)
)

) ;;end brbz

;;; 函数 findper 根据三点坐标，找某点到其他两点形成线的垂直点 ;;;
(defun findper(p0 p1 p2 / point0 point1 point2)
(setq  point0 p0
  point1 p1
  point2 p2
)
(inters (polar point0 (+(angle point1 point2)(/ pi 2)) 10) point0 point1 point2 nil)
)

;;;根据多线段名获得多线段的端点集合 ;;;
(defun getpline (plname / pts x)
(setq pts '())
(mapcar '(lambda (x)
   (if (= (car x) 10)
     (setq pts (cons (cdr x) pts))
   )
   )
   (entget plname)
)
(reverse pts)
)

;;;-------获得传递来的轴线集合返回轴线端点集合-------------;;;
(defun gt:ttt (sszx / ss i en lines)
(if (setq SS sszx)
(progn
(setvar "OSMODE" 0)
(setq i -1)
(repeat (sslength ss)
  (setq en (ssname ss (setq i (1+ i))))
  (setq lines (append lines (getline en)))
)
)
)
(if lines lines)
)

;;;-------获得传递来的直线端点集合返回直线所有交点集合-----------;;;
(defun getinter(line / x y lines inter)
(setq x 0 y 2
  lines line)
(setq inter '())
(repeat (- (/ (length lines) 2) 1)
(repeat (- (/ (- (length lines) x) 2) 1)
(if (inters (nth x lines)(nth (+ x 1) lines)(nth y lines)(nth (+ y 1) lines))
(setq inter (cons (inters (nth x lines)(nth (+ x 1) lines)(nth y lines)(nth (+ y 1) lines)) inter))
)
(setq y (+ y 2))
)
(setq x (+ x 2))
(setq y (+ x 2))
)
(reverse inter)
)

;;;根据直线名获得直线的两个端点集合 ;;;
(defun getline (lname / pts x )
(setq pts '())
(mapcar '(lambda (x)
   (if (or (= (car x) 10) (= (car x) 11))
     (setq pts (cons (3dPoint->2dPoint(cdr x)) pts))
   )
   )
   (entget lname)
)
(reverse pts)
)

;;; 函数：3Dpoint->2Dpoint

(defun 3dPoint->2dPoint  (3dpt)
(list (float (car 3dpt)) (float (cadr 3dpt)))
)