ninja37 发表于 2025-2-13 21:31:10

【悬赏5明经币求程序】求"左下角插入基准图块"的lisp

请求哪位大师帮忙写一个lisp程序

1 选择直线和多段线
2 相交直线计算交点，在交点插入图块21-jzcor00vvv
3 多段线计算包围盒边界左下角dian,inx和miny,插入图块21-jzcor00vvv
注意附件的多段线一般都是封闭矩形
要求能一次选多个直线和多段线


煮茗 发表于 2025-2-13 21:31:11

ninja37 发表于 2025-2-17 18:35
煮茗大师，实在不好意思，是autocad2023，出现以下错误。
命令: LHTUKJZCOR00YUANINT1
★ 功能：批量模板 ...


小可并非大师，一个爱好者而已。
下面这个文件，将(command)调用转换为(command-s)，再试试看吧。


ninja37 发表于 2025-2-15 11:18:46

(defun ssinters      (ss / i num obj1 obj2 j interpts ptlist)
(setq      i   0
                num (sslength ss)
)
(while (< i (1- num))
    (setq obj1 (ssname ss i)
                        obj1 (vlax-ename->vla-object obj1)
                        j    (1+ i)
    )
    (while (< j num)
      (setq obj2   (ssname ss j)
                                obj2   (vlax-ename->vla-object obj2)
                                interpts (vla-intersectwith
                                                                       obj1
                                                                       obj2
                                                                       0
                                                               )
                                interpts (vlax-variant-value interpts)
      )
      (if (> (vlax-safearray-get-u-bound interpts 1) 0)
      (progn
          (setq      interpts
                                                (vlax-safearray->list interpts)
          )
          (while (> (length interpts) 0)
            (setq ptlist (cons (list (car interpts)
                                                                                                                               (cadr interpts)
                                                                                                                               (caddr interpts)
                               )
                                                                                                       ptlist
                         )
            )
            (setq interpts (cdddr interpts))
          )
      )
      )
      (setq j (1+ j))
    )
    (setq i (1+ i))
)
ptlist
)
(defun c:LHTUKJZCOR00YUANINT1 ()
(setvar "cmdecho" 0)
        (setvar "osmode" 0) (setvar "orthomode" 0) (command "UCS""W")
        (command "layer" "on" "40" "")
        (setvar "clayer" "1")
(vl-load-com)
        (setvar "osmode" 0)
        ;;;(setvar "osmode" 15359)
(princ "\n★ 功能：批量模板基准角插入   （碰数点+基准）")
(princ "\n★ 请选择两条相交的直线   （可以多选 批量选择）（非多段线）：")
(command "undo" "be")
;;;        (if (not (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")))))
(if (not (setq ss (ssget '((0 . "*LINE,LWPOLYLINE")))))
    (progn (princ "\n提示：未选取图元，程序退出。\n") (exit))
)
;;;        (command "explode" ss)
(setq acad (vlax-get-acad-object))
(setq acaddocument (vla-get-activedocument acad))
(setq mspace (vla-get-modelspace acaddocument))
        ;;;          (setq blockname (cdr (assoc 2 (entget blockentname))))
        ;;;   (setq blockentname"LHCENPOINT1")
        (setq blockname"21-jzcor03YUAN")
        (setq bili 1.0)
        (initget 6)
(setvar "osmode" 0)
(setq ptlist (ssinters ss))
(foreach pt ptlist
                ;;;(command "_insert" "LHCENPOINT1"(vlax-3d-point ptlist) "1" "1" "1" "0")
                (vla-insertblock mspace(vlax-3d-point pt)"21-jzcor00VVV.dwg" 1 1 1 0)
)
(command "undo" "e")
        (setvar "osmode" 0)
        (setvar "cmdecho" 1)
        ;;;(setvar "osmode" 15359)
(princ)
)这个程序是目前在用的选择相交直线   可以在交点插入图块

煮茗 发表于 2025-2-16 10:41:08

本帖最后由 煮茗 于 2025-2-16 16:06 编辑






说明：根据你提供的代码修改的。
思路是：把选择集进行筛分，如果是多段线，获取其包围框左下角点，插入图块；如果是直线，进行交点分析，获取交点插入图块。

ninja37 发表于 2025-2-17 18:35:52

煮茗大师，实在不好意思，是autocad2023，出现以下错误。
命令: LHTUKJZCOR00YUANINT1
★ 功能：批量模板基准角插入   （碰数点+基准）
★ 请选择两条相交的直线   （可以多选 批量选择）（非多段线）：
选择对象: 指定对角点: 找到 1 个
选择对象:
调用(*push-error-using-command*)前无法从 *error* 调用(command)。
建议将(command)调用转换为(command-s)。
页: [1]
查看完整版本: 【悬赏5明经币求程序】求"左下角插入基准图块"的lisp