增加一个手动选择插入点

wyy81061 · 发表于 2024-12-20 11:09:18

本帖最后由 wyy81061 于 2024-12-20 11:10 编辑

各位大佬帮帮看看，现在的功能只能实现根据多段线颜色生成文字后对齐，但是这个文字的位置不是固定的，我想要增加一个功能，就是根据我鼠标点击的位置做为基准点生成文字

(defun c:XX8 ()
(vl-load-com)
;; 定义颜色与文字的映射表
(setq color-text-map '(
(1 . "48B1") ;; 洋红
(2 . "96B1") ;; 红色
(3 . "72B1") ;; 绿色
(4 . "144B1") ;; 青色
(5 . "36B1") ;; 蓝色
(6 . "12B1") ;; 黄色
(7 . "24B1") ;; 白色
))
;; 获取用户选择的多段线
(setq selection (ssget '((0 . "LWPOLYLINE"))))
(if selection
(progn
(setq horizontal-lines '())
(setq vertical-lines '())
;; 遍历多段线，分类为横向和竖向
(repeat (sslength selection)
(setq ent (ssname selection 0))
(setq obj (vlax-ename->vla-object ent))
;; 获取顶点
(setq vertices (mapcar 'cdr (vl-remove-if-not
'(lambda (x) (= (car x) 10))
(entget ent))))
;; 判断方向
(if (> (abs (- (car (car vertices)) (car (last vertices))))
(abs (- (cadr (car vertices)) (cadr (last vertices)))))
(setq horizontal-lines (cons ent horizontal-lines))
(setq vertical-lines (cons ent vertical-lines))
)
(ssdel ent selection)
)
;; 处理横向多段线
(if horizontal-lines
(progn
;; 以最左边的线为基准
(setq base-line (car (vl-sort horizontal-lines
'(lambda (a b)
(< (car (vlax-curve-getStartPoint a))
(car (vlax-curve-getStartPoint b)))))))
(setq base-center (vlax-curve-getPointAtParam base-line
(vlax-curve-getParamAtDist base-line
(/ (vlax-curve-getDistAtParam base-line
(vlax-curve-getEndParam base-line)) 2))))
;; 遍历横向多段线
(foreach ent horizontal-lines
(setq obj (vlax-ename->vla-object ent))
(setq color (vla-get-color obj))
(setq text (cdr (assoc color color-text-map)))
(if text
(progn
(setq line-center (list (car base-center) (cadr (vlax-curve-getPointAtParam ent
(vlax-curve-getParamAtDist ent
(/ (vlax-curve-getDistAtParam ent
(vlax-curve-getEndParam ent)) 2))))))
(entmake (list
(cons 0 "TEXT")
(cons 10 line-center)
(cons 40 2.5)
(cons 41 0.7)
(cons 7 "宋体")
(cons 1 text)
(cons 50 0)
(cons 62 color)
(cons 72 4)
(cons 73 2)
(cons 11 line-center)
))
)
)
)
)
)
;; 处理竖向多段线
(if vertical-lines
(progn
;; 以最上方的线为基准
(setq base-line (car (vl-sort vertical-lines
'(lambda (a b)
(> (cadr (vlax-curve-getStartPoint a))
(cadr (vlax-curve-getStartPoint b)))))))
(setq base-center (vlax-curve-getPointAtParam base-line
(vlax-curve-getParamAtDist base-line
(/ (vlax-curve-getDistAtParam base-line
(vlax-curve-getEndParam base-line)) 2))))
;; 遍历竖向多段线
(foreach ent vertical-lines
(setq obj (vlax-ename->vla-object ent))
(setq color (vla-get-color obj))
(setq text (cdr (assoc color color-text-map)))
(if text
(progn
(setq line-center (list (car (vlax-curve-getPointAtParam ent
(vlax-curve-getParamAtDist ent
(/ (vlax-curve-getDistAtParam ent
(vlax-curve-getEndParam ent)) 2))))
(cadr base-center)))
(entmake (list
(cons 0 "TEXT")
(cons 10 line-center)
(cons 40 2.5)
(cons 41 0.7)
(cons 7 "宋体")
(cons 1 text)
(cons 50 (/ pi 2))
(cons 62 color)
(cons 72 4)
(cons 73 2)
(cons 11 line-center)
))
)
)
)
)
)
)
(princ "\n未选择任何多段线！")
)
(princ)
)

(defun c:XX8 () 
  (vl-load-com) 
  ;; 定义颜色与文字的映射表 
  (setq color-text-map '( 
    (1 . "48B1")   ;; 洋红 
    (2 . "96B1")   ;; 红色 
    (3 . "72B1")   ;; 绿色 
    (4 . "144B1")  ;; 青色 
    (5 . "36B1")   ;; 蓝色 
    (6 . "12B1")   ;; 黄色 
    (7 . "24B1")   ;; 白色 
  )) 
 
  ;; 获取用户选择的多段线 
  (setq selection (ssget '((0 . "LWPOLYLINE")))) 
  (if selection 
    (progn 
      (setq horizontal-lines '()) 
      (setq vertical-lines '()) 
 
      ;; 遍历多段线，分类为横向和竖向 
      (repeat (sslength selection) 
        (setq ent (ssname selection 0)) 
        (setq obj (vlax-ename->vla-object ent)) 
        ;; 获取顶点 
        (setq vertices (mapcar 'cdr (vl-remove-if-not 
                                     '(lambda (x) (= (car x) 10)) 
                                     (entget ent)))) 
        ;; 判断方向 
        (if (> (abs (- (car (car vertices)) (car (last vertices)))) 
               (abs (- (cadr (car vertices)) (cadr (last vertices))))) 
          (setq horizontal-lines (cons ent horizontal-lines)) 
          (setq vertical-lines (cons ent vertical-lines)) 
        ) 
        (ssdel ent selection) 
      ) 
 
      ;; 处理横向多段线 
      (if horizontal-lines 
        (progn 
          ;; 以最左边的线为基准 
          (setq base-line (car (vl-sort horizontal-lines 
                                        '(lambda (a b) 
                                           (< (car (vlax-curve-getStartPoint a)) 
                                              (car (vlax-curve-getStartPoint b))))))) 
          (setq base-center (vlax-curve-getPointAtParam base-line 
                                                        (vlax-curve-getParamAtDist base-line 
                                                                                   (/ (vlax-curve-getDistAtParam base-line 
                                                                                                                 (vlax-curve-getEndParam base-line)) 2)))) 
          ;; 遍历横向多段线 
          (foreach ent horizontal-lines 
            (setq obj (vlax-ename->vla-object ent)) 
            (setq color (vla-get-color obj)) 
            (setq text (cdr (assoc color color-text-map))) 
            (if text 
              (progn 
                (setq line-center (list (car base-center) (cadr (vlax-curve-getPointAtParam ent 
                                                                                           (vlax-curve-getParamAtDist ent 
                                                                                                                      (/ (vlax-curve-getDistAtParam ent 
                                                                                                                                                    (vlax-curve-getEndParam ent)) 2)))))) 
                (entmake (list 
                  (cons 0 "TEXT") 
                  (cons 10 line-center) 
                  (cons 40 2.5) 
                  (cons 41 0.7) 
                  (cons 7 "宋体") 
                  (cons 1 text) 
                  (cons 50 0) 
                  (cons 62 color) 
                  (cons 72 4) 
                  (cons 73 2) 
                  (cons 11 line-center) 
                )) 
              ) 
            ) 
          ) 
        ) 
      ) 
 
      ;; 处理竖向多段线 
      (if vertical-lines 
        (progn 
          ;; 以最上方的线为基准 
          (setq base-line (car (vl-sort vertical-lines 
                                        '(lambda (a b) 
                                           (> (cadr (vlax-curve-getStartPoint a)) 
                                              (cadr (vlax-curve-getStartPoint b))))))) 
          (setq base-center (vlax-curve-getPointAtParam base-line 
                                                        (vlax-curve-getParamAtDist base-line 
                                                                                   (/ (vlax-curve-getDistAtParam base-line 
                                                                                                                 (vlax-curve-getEndParam base-line)) 2)))) 
          ;; 遍历竖向多段线 
          (foreach ent vertical-lines 
            (setq obj (vlax-ename->vla-object ent)) 
            (setq color (vla-get-color obj)) 
            (setq text (cdr (assoc color color-text-map))) 
            (if text 
              (progn 
                (setq line-center (list (car (vlax-curve-getPointAtParam ent 
                                                                         (vlax-curve-getParamAtDist ent 
                                                                                                    (/ (vlax-curve-getDistAtParam ent 
                                                                                                                                  (vlax-curve-getEndParam ent)) 2)))) 
                                        (cadr base-center))) 
                (entmake (list 
                  (cons 0 "TEXT") 
                  (cons 10 line-center) 
                  (cons 40 2.5) 
                  (cons 41 0.7) 
                  (cons 7 "宋体") 
                  (cons 1 text) 
                  (cons 50 (/ pi 2)) 
                  (cons 62 color) 
                  (cons 72 4) 
                  (cons 73 2) 
                  (cons 11 line-center) 
                )) 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
    (princ "\n未选择任何多段线！") 
  ) 
  (princ) 
)

xyp1964 · 发表于 2024-12-21 01:10:26

自贡黄明儒 · 发表于 2024-12-20 11:35:57

有一个简单办法，生成后，用(command "_.move" ss ''" pt pause)

llsheng_73 · 发表于 2024-12-20 12:50:36

本帖最后由 llsheng_73 于 2024-12-20 12:58 编辑

(setq line-center(list(car base-center)
(cadr(vlax-curve-getPointAtParam ent(vlax-curve-getParamAtDist ent(/(vlax-curve-getDistAtParam ent(vlax-curve-getEndParam ent))2))))))

改成(setq line-center(getpoint"\n指定基准点"))

不过这程序需要优化的地方太多，比如纵线和横线分开后，处理时绝大部分代码重复。这就完全可以考虑根据直接线的起止点计算方向，50组就使用这个方向，这样代码不必重复，甚至不需要判断是纵线还是横线

wyy81061 · 发表于 2024-12-20 14:14:19

llsheng_73 发表于 2024-12-20 12:50
(setq line-center(list(car base-center)
(cadr(vlax-curve-getPointAtParam ent( ...

(defun c:XX7 ()
(vl-load-com)
;; 定义颜色与文字的映射表
(setq color-text-map '(
(1 . "48B1") ;; 洋红
(2 . "96B1") ;; 红色
(3 . "72B1") ;; 绿色
(4 . "144B1") ;; 青色
(5 . "36B1") ;; 蓝色
(6 . "12B1") ;; 黄色
(7 . "24B1") ;; 白色
))
;; 提示用户选择一条多段线
(setq selected-polyline (car (entsel "\n请选择一条多段线：")))
(if selected-polyline
(progn
(setq polyline-obj (vlax-ename->vla-object selected-polyline))
;; 获取点击点
(setq clicked-point (getpoint "\n请选择插入文字的位置："))
;; 获取多段线的起点和终点
(setq start-point (vlax-curve-getStartPoint polyline-obj))
(setq end-point (vlax-curve-getEndPoint polyline-obj))
;; 判断多段线方向
(if (> (abs (- (car start-point) (car end-point)))
(abs (- (cadr start-point) (cadr end-point))))
(setq orientation 'horizontal)
(setq orientation 'vertical)
)
;; 获取多段线颜色并生成文字
(setq color (vla-get-color polyline-obj))
(setq text (cdr (assoc color color-text-map)))
(if text
(progn
;; 根据方向调整文字插入点
(setq text-point
(if (eq orientation 'horizontal)
(list (car clicked-point)
(cadr start-point))
(list (car start-point)
(cadr clicked-point))))
;; 创建文字
(entmake (list
(cons 0 "TEXT")
(cons 10 text-point)
(cons 40 2.5)
(cons 41 0.7)
(cons 7 "宋体")
(cons 1 text)
(cons 50 (if (eq orientation 'horizontal) 0 (/ pi 2)))
(cons 62 color)
(cons 72 4)
(cons 73 2)
(cons 11 text-point)
))
;; 添加“管”字，判断是否需要
(if (or (eq orientation 'horizontal)
(eq orientation 'vertical))
(progn
(setq pipe-point
(if (eq orientation 'horizontal)
(list (car clicked-point)
(+ (cadr start-point) 4))
(list (- (car start-point) 4)
(cadr clicked-point))))
(entmake (list
(cons 0 "TEXT")
(cons 10 pipe-point)
(cons 40 2.5)
(cons 41 0.7)
(cons 7 "宋体")
(cons 1 "管")
(cons 50 (if (eq orientation 'horizontal) 0 (/ pi 2)))
(cons 62 color)
(cons 72 4)
(cons 73 2)
(cons 11 pipe-point)
))
)
)
)
(princ "\n未找到对应颜色的文字映射！")
)
)
(princ "\n未选择任何多段线！")
)
(princ)
)

(defun c:XX7 () 
  (vl-load-com) 
  ;; 定义颜色与文字的映射表 
  (setq color-text-map '( 
    (1 . "48B1")   ;; 洋红 
    (2 . "96B1")   ;; 红色 
    (3 . "72B1")   ;; 绿色 
    (4 . "144B1")  ;; 青色 
    (5 . "36B1")   ;; 蓝色 
    (6 . "12B1")   ;; 黄色 
    (7 . "24B1")   ;; 白色 
  )) 
 
  ;; 提示用户选择一条多段线 
  (setq selected-polyline (car (entsel "\n请选择一条多段线："))) 
  (if selected-polyline 
    (progn 
      (setq polyline-obj (vlax-ename->vla-object selected-polyline)) 
      ;; 获取点击点 
      (setq clicked-point (getpoint "\n请选择插入文字的位置：")) 
      ;; 获取多段线的起点和终点 
      (setq start-point (vlax-curve-getStartPoint polyline-obj)) 
      (setq end-point (vlax-curve-getEndPoint polyline-obj)) 
      ;; 判断多段线方向 
      (if (> (abs (- (car start-point) (car end-point))) 
             (abs (- (cadr start-point) (cadr end-point)))) 
        (setq orientation 'horizontal) 
        (setq orientation 'vertical) 
      ) 
      ;; 获取多段线颜色并生成文字 
      (setq color (vla-get-color polyline-obj)) 
      (setq text (cdr (assoc color color-text-map))) 
      (if text 
        (progn 
          ;; 根据方向调整文字插入点 
          (setq text-point 
                (if (eq orientation 'horizontal) 
                  (list (car clicked-point) 
                        (cadr start-point)) 
                  (list (car start-point) 
                        (cadr clicked-point)))) 
          ;; 创建文字 
          (entmake (list 
            (cons 0 "TEXT") 
            (cons 10 text-point) 
            (cons 40 2.5) 
            (cons 41 0.7) 
            (cons 7 "宋体") 
            (cons 1 text) 
            (cons 50 (if (eq orientation 'horizontal) 0 (/ pi 2))) 
            (cons 62 color) 
            (cons 72 4) 
            (cons 73 2) 
            (cons 11 text-point) 
          )) 
          ;; 添加“管”字，判断是否需要 
          (if (or (eq orientation 'horizontal) 
                  (eq orientation 'vertical)) 
            (progn 
              (setq pipe-point 
                    (if (eq orientation 'horizontal) 
                      (list (car clicked-point) 
                            (+ (cadr start-point) 4)) 
                      (list (- (car start-point) 4) 
                            (cadr clicked-point)))) 
              (entmake (list 
                (cons 0 "TEXT") 
                (cons 10 pipe-point) 
                (cons 40 2.5) 
                (cons 41 0.7) 
                (cons 7 "宋体") 
                (cons 1 "管") 
                (cons 50 (if (eq orientation 'horizontal) 0 (/ pi 2))) 
                (cons 62 color) 
                (cons 72 4) 
                (cons 73 2) 
                (cons 11 pipe-point) 
              )) 
            ) 
          ) 
        ) 
        (princ "\n未找到对应颜色的文字映射！") 
      ) 
    ) 
    (princ "\n未选择任何多段线！") 
  ) 
  (princ) 
)

我原来写的就是对单个多段线的，后面想批量处理，刚开始弄，很多还不清楚，大佬能不能帮忙改进下

wyy81061 · 发表于 2024-12-20 19:23:40

wyy81061 发表于 2024-12-20 14:14
我原来写的就是对单个多段线的，后面想批量处理，刚开始弄，很多还不清楚，大佬能不能帮忙改进下

我上面那个CAD文件里有具体的效果

wyy81061 · 发表于 2024-12-21 13:57:45

xyp1964 发表于 2024-12-21 01:10

我原先的就是这种，主要是我那CAD里的有些多段线是L型，而且还是每一档都要插入文字，这种情况下想自动确定文字插入点也太难了，所以我才想手动选择插入点，虽然麻烦点，但是起码能够实现

wyy81061 · 发表于 2024-12-22 21:02:15

自贡黄明儒发表于 2024-12-20 11:35
有一个简单办法，生成后，用(command "_.move" ss ''" pt pause)

黄大师能不能帮忙提供个完整的？刚开始弄还不熟悉，折腾半天还是没弄好

账号		自动登录	找回密码
密码			注册

[提问] 增加一个手动选择插入点

本帖子中包含更多资源

本帖子中包含更多资源

点评