Help to update an old code

December 15, 2023

Hi , Before start to change the code below (The old code) search to find one layer and then If the layer exist in the drawing start or alert that the LAYER is missing in the drawing.

1 ) I want to update the code to search if LAYER 1 or LAYER2 exist (Is not necessary to exist the both of them only the one of them) and then the code start

2) Alert only is both of the layer is missing.

Here is the code. I add the two layers in the code but, I think that is searching for the both of them and not for one of them.

    (vl-load-com)
    (defun c:symbsxim (/ selset offset_value loops hatch layer)
    (foreach layer '("LAYER1" "LAYER2"
	                 )
          (if (tblsearch "layer" layer)
                (if (and (= (type
                              (setq selset (vl-catch-all-apply
                                             (function
                                               (lambda ()
                                                 (ssget '((0 . "*POLYLINE") (8 . "layer") (-4 . "<OR") (70 . 1) (70 . 129) (-4 . "OR>")))
                                               ) ;_ end of lambda
                                             ) ;_ end of function
                                           ) ;_ end of vl-catch-all-apply
                              ) ;_ end of setq
                            ) ;_ end of type
                            'pickset
                         ) ;_ end of =
                         (= (type (setq offset_value
                                         (vl-catch-all-apply
                                           (function (lambda ()
                                                       (initget "1 2")
                                                       (cond ((getkword "\nSelect offset value [1 - OPTION1/2 - OPTION2] <1> : "))
                                                             (t "1")
                                                       ) ;_ end of cond
                                                     ) ;_ end of lambda
                                           ) ;_ end of function
                                         ) ;_ end of vl-catch-all-apply
                                  ) ;_ end of setq
                            ) ;_ end of type
                            'str
                         ) ;_ end of =
                    ) ;_ end of and
                  (progn (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
                         (setq layer (vla-add (vla-get-layers adoc) "hatched area"))
                         (vla-put-color layer 253) ; change color
                         (vla-put-lineweight layer aclnwt005) ; change lineweight
                         (setq offset_value (cond ((= (atoi offset_value) 1) 0.5)
                                                  ((= (atoi offset_value) 2) 2.0)
                                            ) ;_ end of cond
                               loops        (mapcar (function
                                                      (lambda (ent)
                                                        (vl-sort (mapcar (function (lambda (x)
                                                                                     (setq x (car (vlax-safearray->list (vlax-variant-value x))))
                                                                                     (vla-put-layer x (vla-get-name layer))
                                                                                     x
                                                                                   ) ;_ end of lambda
                                                                         ) ;_ end of function
                                                                         (list (vla-offset (vlax-ename->vla-object ent) offset_value)
                                                                               (vla-offset (vlax-ename->vla-object ent) (- offset_value))
                                                                         ) ;_ end of list
                                                                 ) ;_ end of mapcar
                                                                 (function (lambda (a b) (> (vla-get-area a) (vla-get-area b))))
                                                        ) ;_ end of vl-sort
                                                      ) ;_ end of lambda
                                                    ) ;_ end of function
                                                    ((lambda (/ tab item)
                                                       (repeat (setq tab  nil
                                                                     item (sslength selset)
                                                               ) ;_ end setq
                                                         (setq tab (cons (ssname selset (setq item (1- item))) tab))
                                                       ) ;_ end of repeat
                                                     ) ;_ end of lambda
                                                    )
                                            ) ;_ end of mapcar
                         ) ;_ end of setq
                         (foreach item loops
                           (setq hatch (vla-addhatch
                                         (vla-get-modelspace adoc)
                                         achatchpatterntypepredefined
                                         "ANSI31"
                                         :vlax-false
                                         achatchobject
                                       ) ;_ end of vla-AddHatch
                           ) ;_ end of setq
                           (vla-appendouterloop
                             hatch
                             (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list (car item)))
                           ) ;_ end of vla-appendouterloop
                           (vla-appendinnerloop
                             hatch
                             (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list (cadr item)))
                           ) ;_ end of vla-appendinnerloop
                           (vla-evaluate hatch)
                           (vla-update hatch)
                           (vla-put-patternscale hatch 0.1) ; change hatch scale
                           (vla-put-layer hatch (vla-get-name layer))
                         ) ;_ end of foreach
                         (vla-endundomark adoc)
                  ) ;_ end of progn
                ) ;_ end of if
                (alert "No layer exist in the drawing...")
          ) ;_ end of if (tblsearch "LAYER" "layer")
	) ;_ end foreach layer
          (command "_Setbylayer" (ssget "X") "" "_Yes" "_Yes")
          (princ)
    ) ;_ end of defun

Can any one help?

Thanks

December 15, 2023

I haven't tested this yet, but let me give you a lesson in lists.... see if you can work out the first problem I saw.

So LISP - LISt Processing.... it is designed around lists but get them wrong and odd things happen. Lists can be made up in a few ways:

A. (list ...... ) defines a list

B. (cons .....) defines a list

C. '(..... ) defines a list

C. creates a fixed list and what is inside is not evaluated '(1 2 (+ 2 3)) is 3 items 1, 2, (+ 2 3) (ignoring the error that (+ 2 3) should be a sting)

B. is mostly used in a dotted pair, such as (cons 0 "PolyLine") which might be used in say an ssget filter and is calculated, can be written as '(0 . "POLYLINE")

A. is a generic list function and also creates a list allowing for calculations inside: (list 1 2 (+ 2 3)) is a 3 item list: (1 2 4) - calculation done, can be '(1 2 4)

So in your function above if you have say a list like in C - fixed - and want to do a calculation or use a variable then it might go wrong

See if that helps and take the hint of the example in B, example in ssget.

Might be wrong, might not.

December 15, 2023

Hi Steven P. I can not understand your answer. Can you find any error in the code?

Thanks

December 16, 2023

Drill down on what Steven is saying about lists. you want to use the layer variable in your ssget to do that you need to use (list and (cons to build a list that will be dynamic.

currently when you run this code it use this ssget. twice for each "layer1" and "layer2"

(ssget '((0 . "*POLYLINE") (8 . "layer") (-4 . "<OR") (70 . 1) (70 . 129) (-4 . "OR>")))

You want this ssget to be dynamic so you have to use (list and (cons like this.

(ssget (list (0 . "*POLYLINE") (cons 8 layer) (-4 . "<OR") (70 . 1) (70 . 129) (-4 . "OR>")))

this will be evaluated as when the layer variable is processed.

(ssget '((0 . "*POLYLINE") (8 . "LAYERl") (-4 . "<OR") (70 . 1) (70 . 129) (-4 . "OR>")))
(ssget '((0 . "*POLYLINE") (8 . "LAYER2") (-4 . "<OR") (70 . 1) (70 . 129) (-4 . "OR>")))

--edit

and like steven didn't look past the ssget. so i don't know if their is any other errors.

Edited December 16, 2023 by mhupp

December 16, 2023

Hi mhupp, I try your update. The problem is that the one of the two layer exist in the drawing but when I run the code gives me the option to select the polygon and then skip all the code , alert me that is no layer continiou with bylayer commnd and exit.

Skip the select option 1,2 and the offset hatch polygon.

I can not understan why !!! Any ideas?

Thanks

December 16, 2023

Looking at this,

(ssget '((0 . "*POLYLINE") (8 . "layer") (-4 . "<OR") (70 . 1) (70 . 129) (-4 . "OR>")))

should be

(ssget (list '(0 . "*POLYLINE") (cons 8 layer) '(-4 . "<OR") '(70 . 1) '(70 . 129) '(-4 . "OR>")))

and you want to move the test if the layers exist before the foreach:

The first few lines might be:

(defun c:symbsxim (/ selset offset_value loops hatch layer)

  (setq LayerList '("LAYER1" "LAYER2") )
    (if (or (tblsearch "layer" (car LayerList))
            (tblsearch "layer" (cadr LayerList))
        ) ; endor


  (foreach layer LayerList
;;    (if (tblsearch "layer" layer)
      (if (and....

and ending with

                    (vla-endundomark adoc)
                  ) ;_ end of progn
                ) ;_ end of if
	) ;_ end foreach layer
                (alert "No layer exist in the drawing...")
  ) ;_ end of if (tblsearch "LAYER" "layer")
          (command "_Setbylayer" (ssget "X") "" "_Yes" "_Yes")


          (princ)
)

If you have more than 2 layers to test for the if... tblsearch could be a loop instead checking for each layer

Have a go and see if this will work

December 16, 2023

Try this:

;;Check if Lay1 and/or Lay2 exist(s) in the current drawing (key sensitive!)
(defun lay_exist (lay1 lay2 / l1 l2 lay_name)
  (vlax-for lay (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
    (setq lay_name (vla-get-name lay))
    (if (= lay1 lay_name) (setq l1 T))
    (if (= lay2 lay_name) (setq l2 T))
  )
  (cond
    ( (and l1 l2) (alert (strcat "Both layers \"" lay1 "\" and \"" lay2 "\" exists.")))
    ( l1          (alert (strcat "Only layer \""  lay1 "\" exist.")))
    ( l2          (alert (strcat "Only layer \""  lay2 "\" exist.")))
    ( T           (alert (strcat "None of the \"" lay1 "\" or \"" lay2 "\" layers exist.")))
  )
  (princ)
) ;;lay_exist

December 16, 2023

Hi Steven P. I did the updates but I have to select 2 or 3 times the same polyline before the option menu show up. Any Suggestions ?

    (vl-load-com)

 (defun c:foo (/ selset offset_value loops hatch layer)

  (setq LayerList '("LAYER1" "LAYER2") )
    (if (or (tblsearch "layer" (car LayerList))
            (tblsearch "layer" (cadr LayerList))
        ) ; endor


    (foreach layer LayerList	 

                (if (and (= (type
                              (setq selset (vl-catch-all-apply
                                             (function
                                               (lambda ()
                                             (ssget (list '(0 . "*POLYLINE") (cons 8 layer) '(-4 . "<OR") '(70 . 1) '(70 . 129) '(-4 . "OR>")))
                                               ) ;_ end of lambda
                                             ) ;_ end of function
                                           ) ;_ end of vl-catch-all-apply
                              ) ;_ end of setq
                            ) ;_ end of type
                            'pickset
                         ) ;_ end of =
                         (= (type (setq offset_value
                                         (vl-catch-all-apply
                                           (function (lambda ()
                                                       (initget "1 2")
                                                       (cond ((getkword "\nSelect offset value [1 - OPTION1/2 - OPTION2] <1> : "))
                                                             (t "1")
                                                       ) ;_ end of cond
                                                     ) ;_ end of lambda
                                           ) ;_ end of function
                                         ) ;_ end of vl-catch-all-apply
                                  ) ;_ end of setq
                            ) ;_ end of type
                            'str
                         ) ;_ end of =
                    ) ;_ end of and
                    (progn (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
                         (setq layer (vla-add (vla-get-layers adoc) "HATCH LAYER"))
                         (vla-put-color layer 253) ; change color
                         (vla-put-lineweight layer aclnwt005) ; change lineweight
                         (setq offset_value (cond ((= (atoi offset_value) 1) 0.5)
                                                  ((= (atoi offset_value) 2) 2.0)
                                            ) ;_ end of cond
                               loops        (mapcar (function
                                                      (lambda (ent)
                                                        (vl-sort (mapcar (function (lambda (x)
                                                                                     (setq x (car (vlax-safearray->list (vlax-variant-value x))))
                                                                                     (vla-put-layer x (vla-get-name layer))
                                                                                     x
                                                                                   ) ;_ end of lambda
                                                                         ) ;_ end of function
                                                                         (list (vla-offset (vlax-ename->vla-object ent) offset_value)
                                                                               (vla-offset (vlax-ename->vla-object ent) (- offset_value))
                                                                         ) ;_ end of list
                                                                 ) ;_ end of mapcar
                                                                 (function (lambda (a b) (> (vla-get-area a) (vla-get-area b))))
                                                        ) ;_ end of vl-sort
                                                      ) ;_ end of lambda
                                                    ) ;_ end of function
                                                    ((lambda (/ tab item)
                                                       (repeat (setq tab  nil
                                                                     item (sslength selset)
                                                               ) ;_ end setq
                                                         (setq tab (cons (ssname selset (setq item (1- item))) tab))
                                                       ) ;_ end of repeat
                                                     ) ;_ end of lambda
                                                    )
                                            ) ;_ end of mapcar
                         ) ;_ end of setq
                         (foreach item loops
                           (setq hatch (vla-addhatch
                                         (vla-get-modelspace adoc)
                                         achatchpatterntypepredefined
                                         "ANSI31"
                                         :vlax-false
                                         achatchobject
                                       ) ;_ end of vla-AddHatch
                           ) ;_ end of setq
                           (vla-appendouterloop
                             hatch
                             (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list (car item)))
                           ) ;_ end of vla-appendouterloop
                           (vla-appendinnerloop
                             hatch
                             (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list (cadr item)))
                           ) ;_ end of vla-appendinnerloop
                           (vla-evaluate hatch)
                           (vla-update hatch)
                           (vla-put-patternscale hatch 0.1) ; change hatch scale
                           (vla-put-layer hatch (vla-get-name layer))
                         ) ;_ end of foreach
                           (vla-endundomark adoc)
                    ) ;_ end of progn
                ) ;_ end of if
	) ;_ end foreach layer
      (alert "No layer exist in the drawing...")
  ) ;_ end of if (tblsearch "LAYER" "layer")
          (command "_Setbylayer" (ssget "X") "" "_Yes" "_Yes")
          (princ)
) ;_ end of defun

Thanks

December 17, 2023

Is any way to select one time the line and then go to the option menu ?

Thanks

December 18, 2023

Try this, a few changes to the selection codes and a slight change to the polyline selection 'ssget'

(defun c:foo (/ selset offset_value loops hatch layer)
  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-list-of-all-layers-in-lisp/td-p/822262
  (defun Table (s / d r)
    (while (setq d (tblnext s (null d)))(setq r (cons (cdr (assoc 2 d)) r)) )
  ) ; end defun
  (defun LM:lst->str ( lst del ) ;;Lee Mac
    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
  )
  (defun LM:ListIntersection ( l1 l2 )
    (vl-remove-if-not '(lambda ( x ) (member x l2)) l1)
  )

;;;List of layers
  (setq LayerList '("Layer1" "Layer2") ) ; List of layers
;;;

  (if (= (type (LM:ListIntersection LayerList (Table "layer")) ) 'LIST) ; check if layers exist in drawing
    (progn
      (if (= (setq selset               ; Selection set of closed polylines on layers
               (ssget (list 
                 (cons 0 "*POLYLINE") (cons 8 (LM:lst->str LayerList ","))
                 '(-4 . "<OR") '(70 . 1) '(70 . 129) '(-4 . "OR>")
               )) ; end ssget, list
             ) ; end setq
          nil) ; end =
          (progn
            (princ "No Lines selected") ; no suitable polylines
          )
          (progn
            (initget "1 2")
            (setq offset_value
              (cond ((getkword "\nSelect offset value [1 - OPTION1/2 - OPTION2] <1> : ")) ; get option
                     (t "1")
              ) ;_ end of cond
            ) ; end setq

            (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
            (setq layer (vla-add (vla-get-layers adoc) "HATCH LAYER"))
            (vla-put-color layer 253) ; change color
            (vla-put-lineweight layer aclnwt005) ; change lineweight
            (setq offset_value (cond ((= (atoi offset_value) 1) 0.5)
                                     ((= (atoi offset_value) 2) 2.0)
                               ) ;_ end of cond
                               loops
                               (mapcar (function (lambda (ent)
                                 (vl-sort (mapcar (function (lambda (x)
                                 (setq x (car (vlax-safearray->list (vlax-variant-value x))))
                                 (vla-put-layer x (vla-get-name layer))
                                 x
                                 ) ;_ end of lambda
                                 ) ;_ end of function
                                 (list (vla-offset (vlax-ename->vla-object ent) offset_value)
                                   (vla-offset (vlax-ename->vla-object ent) (- offset_value))
                                 ) ;_ end of list
                                 ) ;_ end of mapcar
                                 (function (lambda (a b) (> (vla-get-area a) (vla-get-area b))))
                                 ) ;_ end of vl-sort
                               ) ;_ end of lambda
                               ) ;_ end of function
                               ((lambda (/ tab item)
                                 (repeat (setq tab nil
                                               item (sslength selset)
                                         ) ;_ end setq
                                         (setq tab (cons (ssname selset (setq item (1- item))) tab))
                                 ) ;_ end of repeat
                               ) ;_ end of lambda
                               )
                             ) ;_ end of mapcar
            ) ;_ end of setq
            (foreach item loops
              (setq hatch (vla-addhatch (vla-get-modelspace adoc)
                                         achatchpatterntypepredefined
                                         "ANSI31"
                                         :vlax-false
                                         achatchobject
                           ) ;_ end of vla-AddHatch
               ) ;_ end of setq
               (vla-appendouterloop hatch
                 (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list (car item)))
               ) ;_ end of vla-appendouterloop
               (vla-appendinnerloop hatch
                 (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list (cadr item)))
               ) ;_ end of vla-appendinnerloop
               (vla-evaluate hatch)
               (vla-update hatch)
               (vla-put-patternscale hatch 0.1) ; change hatch scale
               (vla-put-layer hatch (vla-get-name layer))
             ) ;_ end of foreach
             (vla-endundomark adoc)

        ) ; end progn ssget
      )
    ) ; end progn Layers Exist
    (progn
      (alert "No layers exist in the drawing...")
    ) ; end progn
  ) ;_ end if Layers exist
  (command "_Setbylayer" (ssget "X") "" "_Yes" "_Yes")
  (princ)
)

Edited December 18, 2023 by Steven P

December 18, 2023

Thank you Steven P is working now

December 18, 2023

Slight error in the original code above, I've updated it.

December 29, 2023

Thanks Steven P. Now I see the update

Sign In

Help to update an old code

Recommended Posts

mhy3sx

Steven P

mhy3sx

mhupp

mhy3sx

Steven P

lido

mhy3sx

mhy3sx

Steven P

mhy3sx

Steven P

mhy3sx

Join the conversation

Tutorials

Forums

Activity