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

ninja37

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

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

煮茗

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

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

ninja37

(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 cHTUKJZCOR00YUANINT1 ()
  (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)
)这个程序是目前在用的  选择相交直线   可以在交点插入图块

煮茗

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

ninja37

煮茗大师，实在不好意思，是autocad2023，出现以下错误。
命令: LHTUKJZCOR00YUANINT1
★ 功能：批量模板基准角插入   （碰数点+基准）
★ 请选择两条相交的直线   （可以多选 批量选择）（非多段线）：
选择对象: 指定对角点: 找到 1 个
选择对象:
调用(*push-error-using-command*)前无法从 *error* 调用(command)。
建议将(command)调用转换为(command-s)。