TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: PM on July 05, 2021, 05:11:17 AM

Title: help with lisp
Post by: PM on July 05, 2021, 05:11:17 AM
Hi . I am using QGIS and expord dxf files with multy color solid hatch in one layer.I want to select all the same color solid hatches and move them in  specific layers with scpecific pattern.

The problem is that every time the color of the solid hatches (from QGIS) aren't the same.

The layers i use are every time

      (command "_layer" "_m" "DD" "_c" "90" "" "_lw" "0.09" "" "")
      (command "_layer" "_m" "DA" "_c" "122" "" "_lw" "0.09" "" "")
      (command "_layer" "_m" "AD" "_c" "112" "" "_lw" "0.09" "" "")
      (command "_layer" "_m" "AA" "_c" "205" "" "_lw" "0.09" "" "")
      (command "_layer" "_m" "PD" "_c" "103" "" "_lw" "0.09" "" "")
      (command "_layer" "_m" "PA" "_c" "31" "" "_lw" "0.09" "" "")
      (command "_layer" "_m" "PX" "_c" "73" "" "_lw" "0.09" "" "")
      (command "_layer" "_m" "AN" "_c" "123" "" "_lw" "0.09" "" "")
      (command "_layer" "_m" "XX" "_c" "61" "" "_lw" "0.09" "" "")
      (command "_layer" "_m" "XA" "_c" "63" "" "_lw" "0.09" "" "")
      (command "_layer" "_m" "AX" "_c" "55" "" "_lw" "0.09" "" "")

And the hatch i want to put for this layers are

                DD -> grass3
                DA -> GRASS
                AD -> PLANT
                AA -> SOLID
                PD  ->grass2
                PA  -> ANSI33
                PX  -> Map06
                AN -> urb6
                XX  -> ANSI33
                XA -> NET)
                ΑΧ -> CORK

I upload a test1 dxf file from QGIS and i upload  extra *.pat

Can any one help

Thanks
Title: Re: help with lisp
Post by: PM on July 05, 2021, 12:24:14 PM
Any options?
Title: Re: help with lisp
Post by: BIGAL on July 05, 2021, 09:22:31 PM
Ok I think I understand there is mtext with say DD it sits on top of a hatch so should be easy to chprop of hatch to match dd=grass3.
Title: Re: help with lisp
Post by: ronjonp on July 06, 2021, 11:29:15 AM

The problem is that every time the color of the solid hatches (from QGIS) aren't the same.

Can't write code for something that does not stay consistent ... well you can but your results won't be as intended.  :wink:

Here is a quick one to place the hatches on layers with the same name as the color .. perhaps you can modify to suit your needs.
Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo (/ a s)
  2.   (if (setq s (ssget "_X" '((0 . "HATCH"))))
  3.     (foreach e (mapcar 'cadr (ssnamex s))
  4.       (if (setq a (cdr (assoc 62 (entget e))))
  5.         (entmod (append (entget e) (list (cons 8 (itoa a)))))
  6.       )
  7.     )
  8.   )
  9.   (princ)
  10. )
Title: Re: help with lisp
Post by: PM on July 06, 2021, 12:57:04 PM
I try this and work but i want to  change the layer and move the selection all by layer

Code - Auto/Visual Lisp: [Select]
  1. (defun c:DD1(/ ss)
  2. (command "_layer" "_m" "DD" "_c" "90" "" "_lw" "0.09" "" "")
  3.   (cond ((not acdoc)
  4.         )
  5.   )
  6.   (if
  7.       (setq ss (ssget "_:L" '((0 . "HATCH") (2 . "~GRASS"))))
  8.      (progn
  9.       (vla-StartUndoMark acdoc)
  10.       ((lambda (i / sn)
  11.          (while
  12.            (setq sn (ssname ss (setq i (1+ i))))
  13.             (vla-setPattern
  14.               (vlax-ename->vla-object sn)
  15.               acHatchPatternTypePreDefined
  16.               "GRASS"
  17.             )
  18.          )
  19.        )
  20.         -1
  21.       )
  22.       (vla-EndUndoMark acdoc)
  23.     )
  24.     (princ)
  25.   )
  26.   (princ)
  27. )
  28.  
  29.  
Title: Re: help with lisp
Post by: PM on July 06, 2021, 01:40:20 PM
iI try

Code - Auto/Visual Lisp: [Select]
  1. (command "_.chprop" ss "" "_LA" DD "")
  2.  

but something is going wrong !!
Title: Re: help with lisp
Post by: PM on July 06, 2021, 02:13:39 PM
Hi. I want to move the new hatch to DD layer and i need to add hatch scale to 10


Code - Auto/Visual Lisp: [Select]
  1. (defun c:DD1(/ ss)
  2. (command "_layer" "_m" "DD" "_c" "90" "" "_lw" "0.09" "" "")
  3.   (cond ((not acdoc)
  4.         )
  5.   )
  6.   (if
  7.       (setq ss (ssget "_:L" '((0 . "HATCH") (2 . "~GRASS"))))
  8.      (progn
  9.       (vla-StartUndoMark acdoc)
  10.       ((lambda (i / sn)
  11.          (while
  12.            (setq sn (ssname ss (setq i (1+ i))))
  13.             (vla-setPattern
  14.               (vlax-ename->vla-object sn)
  15.               acHatchPatternTypePreDefined
  16.               "GRASS"
  17.             )
  18.          )
  19.        )
  20.         -1
  21.       )
  22.       (vla-EndUndoMark acdoc)
  23.     )
  24.     (princ)
  25.   )
  26.   (princ)
  27. )
  28.  

Thanks
Title: Re: help with lisp
Post by: PM on July 06, 2021, 04:25:55 PM
any ideas?

Thanks
Title: Re: help with lisp
Post by: ronjonp on July 06, 2021, 04:37:19 PM
iI try

Code - Auto/Visual Lisp: [Select]
  1. (command "_.chprop" ss "" "_LA" DD "")
  2.  

but something is going wrong !!
Try: (command "_.chprop" ss "" "_LA" "DD" "")
Title: Re: help with lisp
Post by: PM on July 06, 2021, 07:56:53 PM
Thanks ronjonp   :smitten:
Title: Re: help with lisp
Post by: BIGAL on July 07, 2021, 12:53:46 AM
This is my attempt and it sort of works, I have problems selecting the hatch using a point. Change the ansi33 to (cadr hlay). It changes the layer and the hatch pattern.

I realised I am probably doing it backwards should look at hatch get boundary then find the text inside version 2.

Please note your labels are very tight in some places to the edge so finding correct text may be difficult.

Code: [Select]
; Change hatch layer based on text inside hatch.
; By alan H

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )
    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse)
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)
(vl-load-com)

(defun t ( / lays )
(setq lays (list '("DD" "grass3")
                '("DA" "GRASS")
                '("AD" "PLANT")
                '("AA" "SOLID")
                '("PD" "grass2")
                '("PA" "ANSI33")
                '("PX" "Map06")
                '("AN" "urb6")
                '("XX" "ANSI33")
                '("XA" "NET")
                '("ΑΧ" "CORK")
)
)
(command "-layer"
"_m" "DD" "_c" "90" "" "_lw" "0.09" ""
"_m" "DA" "_c" "122" "" "_lw" "0.09" ""
"_m" "AD" "_c" "112" "" "_lw" "0.09" ""
"_m" "AA" "_c" "205" "" "_lw" "0.09" ""
"_m" "PD" "_c" "103" "" "_lw" "0.09" ""
"_m" "PA" "_c" "31" "" "_lw" "0.09" ""
"_m" "PX" "_c" "73" "" "_lw" "0.09" ""
"_m" "AN" "_c" "123" "" "_lw" "0.09" ""
"_m" "XX" "_c" "61" "" "_lw" "0.09" ""
"_m" "XA" "_c" "63" "" "_lw" "0.09" ""
"_m" "AX" "_c" "55" "" "_lw" "0.09" ""
"")

;(setq lay (cdr (assoc 8 (entget (car (entsel "\nPick text "))))))
(setq lay "KYROSI")
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(prompt "\nSelect area to be changed ")
(setq ss (ssget (list (cons 0 "MTEXT")(cons 8 lay))))

(repeat (setq x (sslength ss))
(setq ent (entget (ssname ss (setq x (- x 1)))))
(princ (setq  pt  (cdr (assoc 10 ent))))
(setq txt (LM:UnFormat (cdr (assoc 1 ent)) nil))
(command "zoom" "C" pt 100.0)
(vla-getboundingbox (vlax-ename->vla-object ent) 'a 'b)
       (mapcar 'set '(a b) (mapcar 'vlax-safearray->list (list a b)))
       ;; Fuzz value = 1/2 text height
       (setq n (/ (cdr (assoc 40 (entget e))) 2))
       (setq ss2(ssget "_C" (mapcar '- a (list n n)) (mapcar '+ b (list n n)) '((0 . "HATCH"))))
(if (= ss2 nil)
(princ  "Skipped ")
(progn
  (setq ent2 (ssname ss2 0))
  (foreach hlay lays
    (if (= (car hlay) txt)
      (progn
        (command "chprop" ent2 "" "La" (car hlay) "")
        (command "HATCHEDIT" ent2 "P" "Ansi33" "50" "")
      )
    )
  )
)
)
(princ (strcat "\n" (rtos x 2 0)))
)

(princ)
)

(t)
[\code]
Title: Re: help with lisp
Post by: PM on July 07, 2021, 02:33:55 AM
Thanks BIGAL. I try your code but not working. I select the text but do nothing.

I want a litle help with this code .

1)  select Poloyline , text ,mtext,Hach and move the all in layer DD by layer ,exept text and mtext have color white

2)  move  all selected  text and mtext to annotate text style  DASSTYLE with Arrial  font. I add some annotate scales in the dxf file

Code - Auto/Visual Lisp: [Select]
  1. (defun c:DD1(/ ss)
  2.     (vl-load-com)
  3.     (command "_layer" "_m" "DD" "_c" "90" "" "_lw" "0.09" "" "")
  4.       (cond ((not acdoc)
  5.              (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  6.             )
  7.       )
  8.       (if
  9.           (setq ss (ssget "_:L" '((0 . "HATCH") (2 . "~GRASS"))))
  10.          (progn
  11.           (vla-StartUndoMark acdoc)
  12.           ((lambda (i / sn)
  13.              (while
  14.                (setq sn (ssname ss (setq i (1+ i))))
  15.                 (vla-setPattern
  16.                   (vlax-ename->vla-object sn)
  17.                   acHatchPatternTypePreDefined
  18.                   "GRASS"
  19.                 )
  20.              )
  21.            )
  22.             -1
  23.           )
  24.           (vla-EndUndoMark acdoc)
  25.         )
  26.         (princ)
  27.       )
  28.     (command "_.chprop" ss "" "_LA" "DD" "_color" "_bylayer" "")
  29.       (princ)
  30. )    
  31.  
  32.  

Thanks
Title: Re: help with lisp
Post by: PM on July 07, 2021, 04:11:27 PM
I want to change the hatch scale to 5 . I try

Code - Auto/Visual Lisp: [Select]
  1. (setvar "HPSCALE" "10")
  2.  

but is not working

Thanks
Title: Re: help with lisp
Post by: BIGAL on July 07, 2021, 09:05:31 PM
Ok found some more buggy things a couple of the text are extended characters, I have also found that using Ronjonp method sometimes works, but have found a work around it appears that the text must be on top of the hatch not under then the crossing select seems to work. Need more time to test more, need to add the draw order stuff.