logoChat01.ai

Нужно с использованием AutoLISP или Visual LISP (...

تم الإنشاء في: ٢٤ ديسمبر ٢٠٢٥

تمت الإجابة باستخدام GPT-5.2 Thinking بواسطة Chat01

سؤال

Нужно с использованием AutoLISP или Visual LISP (AutoCAD 2021 (RU)) автоматически создать прямоугольник
(цвет прямоугольника 255,255,255) со штриховкой "SOLID" с цветом 255,255,255.

(не использовать в коде function STRINGP и WHEN
не использовать в коде функции типа vlax-curve-p и подобные, которые отсутствует
в стандартной библиотеке AutoLISP)

الفكرة

Confirming truecolor and ACI handling in AutoCAD

The formula for setting the truecolor (R65536 + G256 + B) appears correct, as it matches the BGR byte order. Group 62, which manages ACI colors, can be set to 256 for BYLAYER. For truecolor, I could either omit 62 or set it to 256, but I might prefer removing 62 and explicitly setting it to 7 (white).

Handling truecolor and ACI color assignment in AutoCAD

The requirement specifies RGB 255, 255, 255, but ACI 7 doesn't always match this. To ensure the correct truecolor, I'll set group 62 to 7 (non-BYLAYER) and include group 420 for truecolor. Although CECOLOR could be used to directly set RGB values, it won't automatically affect entmakex, so I need to manage the group codes myself.

Managing color settings for truecolor and ACI

We can set group 62 to 7 and 420 for compatibility, with 420 overriding color to truecolor, following AutoCAD's handling of true colors. We'll keep 62 set to 7 (white for compatibility), and for polyline and hatch, use 420 with truecolor 16777215 for white. Although ACI 7 may appear black on a white background, truecolor should meet the requirement.

Adapting _setTrueColor for polyline and hatch

I'll update _setTrueColor to adjust both 420 and 62, setting 62 to 7 and ensuring no conflict with bylayer. Polyline and hatch adjustments are needed, with the rectangle's border showing and using "SOLID" for the hatch pattern. I'll avoid using expressions like when, stringp, or vlax-curve-p.

Delivering final code with error handler and edge cases

I'll deliver the final code with instructions and an error handler to restore variables like CMDECHO. Instead of "when", I'll use "if" inside the error function. For edge cases, I'll handle 3D corner values for elevation properly. I'll craft the code, avoiding reserved function names and explaining each part, ensuring all necessary values are set.

Thought for 1m 51s

الإجابة

Ниже — рабочий пример AutoLISP/Visual LISP для AutoCAD 2021 (RU): создаёт прямоугольник (LWPOLYLINE) и штриховку SOLID внутри него, и для обоих ставит TrueColor RGB(255,255,255).

TrueColor пишется через DXF-код 420 (24-битное значение; младший байт — Blue, затем Green, затем Red). (Documentation Help)
(В коде нет STRINGP и нет WHEN; также не используются vlax-curve-p и подобные.)

lisp
(vl-load-com)

;; RGB -> DXF 420 (B + 256*G + 65536*R)
(defun MT:RGB->420 (rgb / r g b)
  (setq r (car rgb)
        g (cadr rgb)
        b (caddr rgb))
  (+ b (* 256 g) (* 65536 r))
)

;; Установить TrueColor (DXF 420) и продублировать ACI=7 (белый) для совместимости
(defun MT:SetTrueColor (ename rgb / d c420 a62)
  (setq d   (entget ename)
        c420 (cons 420 (MT:RGB->420 rgb))
        a62  (cons 62 7))

  ;; 420
  (if (assoc 420 d)
    (setq d (subst c420 (assoc 420 d) d))
    (setq d (append d (list c420)))
  )

  ;; 62
  (if (assoc 62 d)
    (setq d (subst a62 (assoc 62 d) d))
    (setq d (append d (list a62)))
  )

  (entmod d)
  (entupd ename)
  ename
)

;; Активное пространство (Model/Paper), чтобы штриховка создавалась там же
(defun MT:GetActiveSpace (doc)
  (if (= (getvar "CVPORT") 1)
    (vla-get-PaperSpace doc)
    (vla-get-ModelSpace doc)
  )
)

;; Создать прямоугольник как LWPOLYLINE (замкнутую)
(defun MT:MakeRectPL (p1 p2 / x1 x2 y1 y2 z pl)
  (setq x1 (min (car p1) (car p2))
        x2 (max (car p1) (car p2))
        y1 (min (cadr p1) (cadr p2))
        y2 (max (cadr p1) (cadr p2))
        z  (if (caddr p1) (caddr p1) 0.0)
  )

  (setq pl
    (entmakex
      (list
        (cons 0   "LWPOLYLINE")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbPolyline")
        (cons 90  4)
        (cons 70  1)          ; closed
        (cons 38  z)          ; elevation
        (cons 10  (list x1 y1))
        (cons 10  (list x2 y1))
        (cons 10  (list x2 y2))
        (cons 10  (list x1 y2))
      )
    )
  )
  pl
)

;; Создать SOLID hatch по границе polyline (ActiveX), вернуть ename штриховки
(defun MT:SolidHatchByBoundary (plEname / acad doc sp hatch sa var hEname)
  (setq acad (vlax-get-acad-object)
        doc  (vla-get-ActiveDocument acad)
        sp   (MT:GetActiveSpace doc)
  )

  ;; 0 = acHatchPatternTypePreDefined
  (setq hatch (vla-AddHatch sp 0 "SOLID" :vlax-true))

  (setq sa (vlax-make-safearray vlax-vbObject '(0 . 0)))
  (vlax-safearray-put-element sa 0 (vlax-ename->vla-object plEname))
  (setq var (vlax-make-variant sa))

  (vla-AppendOuterLoop hatch var)
  (vla-Evaluate hatch)

  (setq hEname (vlax-vla-object->ename hatch))
  hEname
)

;; Команда: WRECT  (создаёт белый прямоугольник + белую SOLID-штриховку)
(defun c:WRECT (/ p1 p2 pl h)
  (setq p1 (getpoint "\nУкажите первую точку прямоугольника: "))
  (if p1
    (progn
      (setq p2 (getcorner p1 "\nУкажите противоположный угол: "))
      (if p2
        (progn
          (setq pl (MT:MakeRectPL p1 p2))
          (if pl
            (progn
              (MT:SetTrueColor pl '(255 255 255))
              (setq h (MT:SolidHatchByBoundary pl))
              (if h
                (MT:SetTrueColor h '(255 255 255))
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

Как использовать:

  1. Сохраните в *.lsp → загрузите через APPLOAD.
  2. В командной строке выполните: WRECT → укажите две точки (диагональ прямоугольника).

Если нужно сделать без запросов (например, прямоугольник фиксированного размера от (0,0)), скажите размеры/координаты — подставлю в код.

مشاركة هذا السؤال والجواب