lisp创建层并调用乐筑天下 - Powered by Discuz! Archiver

Lee Mac 发表于 2022-7-6 09:53:16

嗨，李麦克，
听起来不错。我想保留原作的颜色，但要比原作浅一点，我希望用亮度做到这一点。我希望在亮度上加一个30左右的标准值，以创造出更亮的颜色。
谢谢

woodman78 发表于 2022-7-6 09:58:52

尝试以下几点：

您需要从这里学习必要的子功能。

下面演示了如何调用上述子功能，将所选TrueColor值的亮度设置为50，保留色调/饱和度值（假设用户从对话框中选择TrueColour值-如果没有，则需要将ACI颜色转换为TrueColour，然后再提供给上述子功能）：

;; Arguments:
;; tc- TrueColour value (Integer)
;; lum - Luminance value (Integer 0 <= lum <= 100)
;; Returns: TrueColour value with Luminance set to value specified

(defun SetLuminance ( tc lum / hsl )
( (lambda ( hsl ) (apply 'LM:RGB->True (LM:HSL->RGB (car hsl) (cadr hsl) lum)))
(apply 'LM:RGB->HSL (LM:True->RGB tc))
)
)

Lee Mac 发表于 2022-7-6 10:00:36

谢谢李和pBe的帮助。我一直在尝试集成你的代码LeeMac，但一直在努力。

这就是我所拥有的，但我认为

(defun c:test ( / layer lst )

(setq layer "Layer1")

(if (setq lst (acad_truecolordlg '(62 . 7) nil))
(entmake
(list
   (cons 0 "LAYER")
   (cons 100 "AcDbSymbolTableRecord")
   (cons 100 "AcDbLayerTableRecord")
   (cons 2 layer)
   (cons 70 0)
   (cons 420 (SetLuminance (cdr (assoc 420 lst)) 50))
)
)
)
(princ)
)应该在pline命令之后进入吗？？？

（defun c：土地所有者（/Layername LayerColor name）（setq SUCE（getvar“cmdecho”）（setq SUOM（getvar“orthomode”））（setq SUSM（getvar“osmode”））（setq SUAB（getvar“angbase”））（setq SUAD（getvar“angdir”））（setq SUCL（getvar“clayer”））（setq SUCR（getvar“cecolor”））（setq dcl\u id（load\u dialog“landowner.dcl”）（if（not）（new\u dialog“landowner”dcl u id））（退出））；if（if*name1*（set\u tile“name”*name1*）（set\u tile“name”“Default”）（action\u tile“name”“（setq*name1*$value）”）（start\u dialog）（unload\u dialog dcl\u id）（setq layername（strcat“CCC\u LANDOWNER”*name1*）LayerColor（acad\u truecolordlg（62.7）nil））（entmake（list（cons 0“LAYER”）（cons 100“acdbsymbolbollerecord”）（cons 100“AcDbLayerTableRecord”）（cons 2 Layername）（car LayerColor）（if（>（length LayerColor）1）（car（cdr LayerColor））（cons 70 0）（cons 420（SetLuminance（cdr（assoc 420 lst））50））（setvar“clayer”Layername）（命令“.U pline”）（while（=1（logand 1（getvar“cmdactive”）））（命令暂停））（setq pline（entlast）elist（entget pline））（命令“\u chprop”pline“\u color”（cdr（car LayerColor））”“”）（命令“\uDraworder”pline“\u F”）；True（LM:HSL->RGB（car HSL）（cadr HSL）lum））（应用“LM:RGB->HSL（LM:True->RGB tc）））；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；；RGB->HSL-Lee Mac 2011；；参数：r、g、b-红色、绿色、蓝色值（定义LM:RGB->HSL（r g b/U round d h l m n s）（setq r（/r 255。）克（/克255。）b（/b 255。）n（最小r g b）m（最大r g b）d（-m n）l（/（+m n）2）（defun _round（n）（fix（+n（if（minusp n）-0.5 0.5）））（mapcar _round（cond（（zerop d）（list 0 0（*m 100））（t（setq s（if（<l 0.5）（/d（+m n））（/d（-2.m））（setq h（cond（（=g m）（+（/（-b r）d）2））（（（=b m）（+（/（-r）d）4））（/（（/（-g b）d）））（list（rem 360（*h 60））360）（*s 100）（*l 100））；；RGB->True-Lee Mac 2011；；Args:r，g，b-红，绿，蓝值（defun LM:RGB->真（r g b）（+（lsh（fix r）16）（lsh（fix g）（fix b））；；HSL->RGB-Lee Mac 2011；；参数：0

woodman78 发表于 2022-7-6 10:04:23

不，请看我的例子，这一行是用来设置图层颜色的。

我不知道为什么你把这些部分标成红色，因为你没有改变大部分的系统变量。

此外，您似乎试图设置层颜色两次（以绿色标记）。

我无法测试以下内容，因为我没有您的DCL等，但请将代码的顶部改为：

（定义c：土地所有者（/elast id lst name old vars）（setq vars’（“CLAYER”“HPNAME”“HPSCALE”）old（mapcar‘getvar vars））（cond（（或（

Lee Mac 发表于 2022-7-6 10:06:51

李，这是我做的，但有几件事。当我从Truecolour对话框中选择颜色时，亮度可以调整，但它会立即将该颜色指定为bylayer，因此pline是较浅的颜色。我打算将选定的颜色分配给柱脚，然后将较浅的颜色分配给图案填充。

hatch命令也不起作用。当我关闭pline时，它就结束了。而且它似乎没有设置图案填充变量。

我已经包括了mt DCL，以防你有机会测试。

谢谢李的工作。

landowner: dialog
{label = "Landowner Layer Creation";
: edit_box
{
label = "Enter landowner name :";
key = "name";
alignment = centered;
edit_limit = 45;
edit_width = 50;
}

: button
{
key = "accept";
label = "OK";
is_default = true;
fixed_width = true;
alignment = centered;
}

: errtile
{
width = 34;
}
}

woodman78 发表于 2022-7-6 10:10:07

尝试附加的LISP和DCL。
土地所有者。lsp
土地所有者。dcl

Lee Mac 发表于 2022-7-6 10:13:03

这太棒了。谢谢李·麦克。在绘制土地所有者地图时会节省我很多时间。

再次感谢。

woodman78 发表于 2022-7-6 10:17:28

只要看看它，正如关于使用ACI所说的那样，让用户选择一个ACI并将其转换为True会更有意义。我换了线路

(defun c:landowner (/ Layername LayerColor name)
(setq SUCE (getvar "cmdecho"))
(setq SUOM (getvar "orthomode"))
(setq SUSM (getvar "osmode"))
(setq SUAB (getvar "angbase"))
(setq SUAD (getvar "angdir"))
(setq SUCL (getvar "clayer"))
(setq SUCR (getvar "cecolor"))
(setq dcl_id (load_dialog "landowner.dcl"))
(if (not (new_dialog "landowner" dcl_id))
(exit)
);if
(if *name1*
(set_tile "name" *name1*)
(set_tile "name" "Default")
)
(action_tile "name" "(setq *name1* $value)")
(start_dialog)
(unload_dialog dcl_id)
(setq layername (strcat "CCC_LANDOWNER_"*name1*)
         LayerColor (acad_truecolordlg '(62 . 7) nil))
(entmake (list (cons 0 "LAYER")
            (cons 100 "AcDbSymbolTableRecord")
            (cons 100 "AcDbLayerTableRecord")
            (cons 2 Layername)
            (car LayerColor)
         (if (> (length LayerColor) 1)
               (car (cdr LayerColor)))
            (cons 70 0)
   (cons 420 (SetLuminance (cdr (assoc 420 lst)) 50))
)
)
)

(setvar "clayer" layername)
(command "._pline")
(while (= 1 (logand 1 (getvar "cmdactive")))
(command pause))
(setq pline (entlast)
elist (entget pline)
)
(command "_chprop" pline "" "_color" (cdr (car LayerColor)) "" "")
(command "_.draworder" pline "" "_F");<--set pline's draw order to front

(setvar "hpname" "honey")
(setvar "hpscale" 2)
(command "-hatch" "S" pline "" "")
(setvar "hpname" ".")

(setvar "cmdecho" SUCE)
(setvar "orthomode" SUOM)
(setvar "osmode" SUSM)
(setvar "angbase" SUAB)
(setvar "angdir" SUAD)
(setvar "clayer" SUCL)
(setvar "cecolor" SUCR)

(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun SetLuminance ( tc lum / hsl )
( (lambda ( hsl ) (apply 'LM:RGB->True (LM:HSL->RGB (car hsl) (cadr hsl) lum)))
(apply 'LM:RGB->HSL (LM:True->RGB tc))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; RGB -> HSL - Lee Mac 2011
;; Args: r,g,b - Red,Green,Blue values

(defun LM:RGB->HSL ( r g b / _round d h l m n s )

(setq r (/ r 255.)
   g (/ g 255.)
   b (/ b 255.)
   n (min r g b)
   m (max r g b)
   d (- m n)
   l (/ (+ m n) 2.)
)
(defun _round ( n )
(fix (+ n (if (minusp n) -0.5 0.5)))
)
(mapcar '_round
(cond
( (zerop d)
   (list 0 0 (* m 100))
)
(t
   (setq s (if (< l 0.5) (/ d (+ m n)) (/ d (- 2. m n))))
   (setq h
      (cond
      ( (= g m) (+ (/ (- b r) d) 2))
      ( (= b m) (+ (/ (- r g) d) 4))
      ( (/ (- g b) d))
      )
   )
   (list (rem (+ 360 (* h 60)) 360) (* s 100) (* l 100))
)
)
)
)

;; RGB -> True - Lee Mac 2011
;; Args: r,g,b - Red,Green,Blue values

(defun LM:RGB->True ( r g b )
(+
(lsh (fix r) 16)
(lsh (fix g)
(fix b)
)
)

;; HSL -> RGB - Lee Mac 2011
;; Args: 0 <= h <= 360, 0 <= s,l <= 100

(defun LM:HSL->RGB ( h s l / _sub _round u v )

(setq h (/ h 360.)
   s (/ s 100.)
   l (/ l 100.)
)
(defun _sub ( u v h )
(setq h (rem (1+ h) 1))
(cond
( (< (* 6 h) 1) (+ u (* 6 h (- v u))))
( (< (* 2 h) 1) v)
( (< (* 3 h) 2) (+ u (* 6 (- (/ 2. 3.) h) (- v u))))
( u )
)
)
(defun _round ( n )
(fix (+ n (if (minusp n) -0.5 0.5)))
)
(mapcar '_round
(mapcar '* '(255 255 255)
(cond
   ( (zerop s)
      (list l l l)
   )
   ( (zerop l)
   '(0 0 0)
   )
   (t
      (setq v (if (< l 0.5) (* l (1+ s)) (- (+ l s) (* l s)))
            u (- (* 2 l) v)
      )
      (mapcar '(lambda ( h ) (_sub u v h)) (list (+ h (/ 1. 3.)) h (- h (/ 1. 3.))))
   )
)
)
)
)

;; True -> RGB - Lee Mac 2011
;; Args: c - True Colour

(defun LM:True->RGB ( c )
(list
(lsh (lsh (fix c) -24)
(lsh (lsh (fix c) 16) -24)
(lsh (lsh (fix c) 24) -24)
)
)

要调用ACI对话框并添加到子函数中，请执行以下操作：

(defun c:landowner ( / elast id lst name old vars )

(setq vars '("CLAYER" "HPNAME" "HPSCALE")
   old (mapcar 'getvar vars)
)
(cond
( (or
   (<= (setq id (load_dialog "landowner.dcl")) 0)
   (not (new_dialog "landowner" id))
)
(princ "\n--> Error Loading Dialog.")
)
(t
(set_tile "name" (cond (*name1*) ("Default")))
(action_tile "name" "(setq *name1* $value)")

(if
   (and
      (= 1 (start_dialog))
      (setq lst (acad_truecolordlg '(62 . 7) nil))
   )
   (progn
      (setq name (strcat "CCC_LANDOWNER_"*name1*))

      (if (null (tblsearch "LAYER" name))
      (entmake
         (list
            (cons 0 "LAYER")
            (cons 100 "AcDbSymbolTableRecord")
            (cons 100 "AcDbLayerTableRecord")
            (cons 2 name)
            (cons 70 0)
            (cond
            ( (assoc 420 lst)
               (cons 420 (SetLuminance (cdr (assoc 420 lst)) 50))
            )
            ( (assoc 62 lst) )
            )
         )
      )
      )
      (setvar 'CLAYER name)

      (setq elast (entlast))
      (command "_.pline")
      (while (= 1 (logand 1 (getvar 'CMACTIVE))) (command pause))

      (if (not (equal elast (setq elast (entlast))))
      (progn
         (command "_.draworder" elast "" "_F")
         (setvar 'HPNAME "honey")
         (setvar 'HPSCALE 2)
         (command "_.-hatch" "_S" elast "" "")
         (setvar 'HPNAME ".")
      )
      )
   )
)
)
)
(if (< 0 id) (unload_dialog id))
(mapcar 'setvar vars old)
(princ)
)

但是如何将lst变量传递给子函数呢？

woodman78 发表于 2022-7-6 10:18:40

也许值得一提的是，在我重写整个代码之前。。。但是我想我是重写它的罪魁祸首。

更改：

landowner: dialog
{label = "Landowner Layer Creation";
: edit_box
         {
label = "Enter landowner name :";
key = "name";
alignment = centered;
edit_limit = 45;
edit_width = 50;
}

: button
{
key = "accept";
label = "OK";
is_default = true;
fixed_width = true;
alignment = centered;
}

: errtile
{
width = 34;
}
}

收件人：

(setq lst (acad_colordlg 1 nil))

以及：

;; ACI -> True - Lee Mac 2011
;; Args: c - ACI (AutoCAD Colour Index) Colour

(defun LM:ACI->True ( c / cObj tc ) (vl-load-com)
(if
(and (<= 1 c 255)
(setq cObj
   (vla-getInterfaceObject (vlax-get-acad-object)
      (strcat "AutoCAD.AcCmColor." (substr (getvar 'ACADVER) 1 2))
   )
)
(not
   (vl-catch-all-error-p
      (vl-catch-all-apply 'vla-put-ColorIndex (list cObj c))
   )
)
)
(setq tc (LM:RGB->True (vla-get-Red cObj) (vla-get-Green cObj) (vla-get-Blue cObj)))
)
(if cObj (vlax-release-object cObj))
tc
)

收件人：

14

Lee Mac 发表于 2022-7-6 10:22:07

页: 1 [2]

乐筑天下's Archiver