Author Topic: vl-string-left-trim  (Read 7079 times)

0 Members and 1 Guest are viewing this topic.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: vl-string-left-trim
« Reply #15 on: December 15, 2019, 02:23:39 PM »
Ok thanks.

On a different note, this quick and dirty stab (coded blind so I don't know if it works) is how I might structure the code so there's less repetition of logic and it's more discernible / maintainable (subjective := yes):

Code: [Select]
(defun C:TBUP ( / add:val base:len base:name bps:no city client date drh:no dwg:len dwg:name dwg:prefix job:no lb:val plan:no subdiv )

    (setq
        dwg:prefix (getvar 'dwgprefix)
        bps:no     (vl-filename-base (vl-filename-directory dwg:prefix))
        dwg:name   (getvar 'dwgname)
        dwg:len    (strlen dwg:name)
        base:name  (vl-filename-base dwg:name)
        base:len   (strlen base:name)
        job:no     (substr base:name 8 9)
        client     (vl-string-trim " " (getstring T "\n* Enter Residence Client:"))
        client     (if (eq "" client) "RESIDENCE" client)
        subdiv     (vl-string-trim " " (getstring T "\n* Enter Subdivison:"))
        subdiv     (if (eq "" subdiv) "Highcroft Estates, Phase 1")
        city       (vl-string-trim " " (getstring T "\n* Enter City State:"))
        city       (if (eq "" city) "Arlington, TX 76001" city)
        date       (ARCH:C_DATE-ISSUE (getvar "tdupdate")) 
    )   

    ;;  Assumes rev number is always a single digit.
   
    (if (wcmatch (strcase base:name) "*R#")
        (setq
            drh:no  (strcat (substr dwg:name (- base:len 16) 5) (substr dwg:name (- base:len  7) 8))
            plan:no (strcat "PLAN " (substr dwg:name (- dwg:len 20) 17))
            lb:val  (strcat "LOT "  (substr dwg:name (- dwg:len 27) 2) ", BLOCK " (substr dwg:name (- dwg:len 23) 2))
            add:val (substr (substr dwg:name 1 (- dwg:len 30)) 18)
        )
        (setq
            drh:no  (strcat (substr dwg:name (- base:len 13) 5) (substr dwg:name (- base:len  4) 5))
            plan:no (strcat "PLAN " (substr dwg:name (- dwg:len 17) 14))
            lb:val  (strcat "LOT "  (substr dwg:name (- dwg:len 24) 2) ", BLOCK " (substr dwg:name (- dwg:len 20) 2))
            add:val (substr (substr dwg:name 1 (- dwg:len 27)) 18)
        )
    )
   
    (foreach pair
        (mapcar 'cons   
           '("DRHNO" "PLANNO" "ADD" "LB" "DATE" "BPSNO" "JOBNO" "RES" "SUB" "CITY")
            (list drh:no plan:no add:val lb:val date bps:no job:no client subdiv city)
        )           
        (ARCH:UpdateBlocks "DRHortonTBH" (car pair) (cdr pair))
    )
   
    (ARCH:MsgBox1
        " Arch2Program© : Message"
        64 ;; bit coded var for dialog style?
        (strcat "DR Horton Titleblock Updated Successfully")
        2  ;; bit coded var for icon style?
    )

    (princ)

)

For what it's worth, cheers.
« Last Edit: December 15, 2019, 05:14:08 PM by MP »
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: vl-string-left-trim
« Reply #16 on: December 15, 2019, 02:38:00 PM »
@MP, I think you missed :

Code: [Select]
(setq dwg:name (getvar 'dwgname))

There may be something I haven't noticed, but anyway very well coded...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: vl-string-left-trim
« Reply #17 on: December 15, 2019, 02:43:14 PM »
Indeed, fixed and thanks ribarm.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

GDF

  • Water Moccasin
  • Posts: 2081
Re: vl-string-left-trim
« Reply #18 on: December 15, 2019, 03:01:52 PM »
WOW

Thanks...this will keep me busy and out of trouble for a long time digesting your code.
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: vl-string-left-trim
« Reply #19 on: December 15, 2019, 03:09:43 PM »
You're welcome sir.

PS: I noticed some other distillage that could be performed (res, sub, city) and revised it accordingly.

Cheers.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

GDF

  • Water Moccasin
  • Posts: 2081
Re: vl-string-left-trim
« Reply #20 on: December 15, 2019, 03:38:34 PM »
Thank you again MASTER CODER, I mean MP. It's remarkable that you could write this code without being able to test it. My hat's off to you.


Code: [Select]
(defun C:TBMP ( / client subdiv city dwg:prefix dwg:name dwg:len base:name base:len drh:no plan:no add:val lb:val )

    (setq
        dwg:prefix    (getvar 'dwgprefix)
        parent:folder (vl-filename-base (vl-filename-directory dwg:prefix))
        dwg:name      (getvar 'dwgname)
        dwg:len       (strlen dwg:name)
        base:name     (vl-filename-base dwg:name)
        base:len      (strlen base:name)
        job:no        (substr base:name 8 9)     
    )

    ;;  Assumes rev number is always a single digit.
   
    (if (wcmatch (strcase base:name) "*R#")
        (setq
            drh:no  (strcat (substr dwg:name (- base:len 16) 5) (substr dwg:name (- base:len  7) 8))

            ;;plan:no (strcat "PLAN " (substr dwg:name (- dwg:len 17) 14))
            plan:no (strcat "PLAN " (substr dwg:name (- dwg:len 20) 17))         
 
            lb:val  nil ;; not needed but makes intention clear
            add:val (substr (substr dwg:name 1 (- dwg:len 30)) 18)
        )
        (setq
            drh:no  (strcat (substr dwg:name (- base:len 13) 5) (substr dwg:name (- base:len  4) 5))

            ;;plan:no (strcat "PLAN " (substr dwg:name (- dwg:len 20) 17))
            plan:no (strcat "PLAN " (substr dwg:name (- dwg:len 17) 14))

            lb:val  (strcat "LOT "  (substr dwg:name (- dwg:len 24) 2) ", BLOCK " (substr dwg:name (- dwg:len 20) 2))
            add:val (substr (substr dwg:name 1 (- dwg:len 27)) 18)
        )
    )
   
    (ARCH:UpdateBlocks "DRHortonTBH" "DRHNO"  drh:no)
    (ARCH:UpdateBlocks "DRHortonTBH" "PLANNO" plan:no)
    (ARCH:UpdateBlocks "DRHortonTBH" "ADD"    add:val) 
     
    (if lb:val (ARCH:UpdateBlocks "DRHortonTBH" "LB" lb:val))
   
    (ARCH:UpdateBlocks "DRHortonTBH" "DATE" (ARCH:C_DATE-ISSUE (getvar "tdupdate")))
    (ARCH:UpdateBlocks "DRHortonTBH" "BPSNO" parent:folder)
    (ARCH:UpdateBlocks "DRHortonTBH" "JOBNO" job:no)

    (if (eq "" (vl-string-trim " " (setq client (getstring T "\n* Enter Residence Client:"))))
        (ARCH:UpdateBlocks "DRHortonTBH" "RES" "RESIDENCE")
        (ARCH:UpdateBlocks "DRHortonTBH" "RES" client)
    )

    (if (eq "" (setq subdiv (vl-string-trim " " (getstring T "\n* Enter Subdivison:"))))
        (ARCH:UpdateBlocks "DRHortonTBH" "SUB" "Highcroft Estates, Phase 1")
        (ARCH:UpdateBlocks "DRHortonTBH" "SUB" subdiv)
    )

    (if (eq "" (setq city (vl-string-trim " " (getstring T "\n* Enter City State:"))))
        (ARCH:UpdateBlocks "DRHortonTBH" "CITY" "Arlington, TX 76001")
        (ARCH:UpdateBlocks "DRHortonTBH" "CITY" city)
    )

    (ARCH:MsgBox1
        " Arch2Program© : Message"
        64 ;; bit coded var for dialog style?
        (strcat "DR Horton Titleblock Updated Successfully")
        2  ;; bit coded var for icon style?
    )

    (princ)
   
)
« Last Edit: December 15, 2019, 03:53:44 PM by GDF »
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: vl-string-left-trim
« Reply #21 on: December 15, 2019, 05:23:36 PM »
You're most welcome sir.

PS:
  • Updated code to reflect correction of index errors you flagged.
  • Plus one I believe you missed.
  • Did final refactoring.

Cheers.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

GDF

  • Water Moccasin
  • Posts: 2081
Re: vl-string-left-trim
« Reply #22 on: December 15, 2019, 06:51:03 PM »
 :smitten:
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: vl-string-left-trim
« Reply #23 on: December 15, 2019, 07:08:34 PM »
Was fun + your response made it golden.

Still room for improving the string slicing, dicing but honey-do list abounds.

Cheers. :-)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

GDF

  • Water Moccasin
  • Posts: 2081
Re: vl-string-left-trim
« Reply #24 on: December 16, 2019, 08:03:39 AM »
Hey, I have hundreds of more poorly written code that need a little house cleaning... :2funny:

 :smitten:
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: vl-string-left-trim
« Reply #25 on: December 16, 2019, 09:21:34 AM »
First crystal meth sample is always free. :evil:
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

GDF

  • Water Moccasin
  • Posts: 2081
Re: vl-string-left-trim
« Reply #26 on: December 16, 2019, 10:05:38 AM »
Your rewriting of the code thru progressing stages would be an great teaching aid!

I have learned a lot from your progressive coding technique! Thank you, and I hope others can learn from this exercise.
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: vl-string-left-trim
« Reply #27 on: December 16, 2019, 10:11:22 AM »
It’s funny you mentioned that. When you said “I have hundreds ...” I thought “send me a dozen worthy candidates - I’ll revise one of them if you allow me to publish an article about the refactoring of same”. Obviously any proprietary info would have to be removed or obfuscated.

Anyway, thanks so much for your kind words, music to me.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

GDF

  • Water Moccasin
  • Posts: 2081
Re: vl-string-left-trim
« Reply #28 on: December 16, 2019, 10:30:39 AM »
Here is a messy floor sq ft code based upon getting the area of a hatch.
It' in bad shape...but works for me.

Code: [Select]
;; EN   entity name of insert
;; TAG  attribute tag
;; NEW  new attribute value [string]
;;
;; Replaces current attribute value stored in
;; drawing with the NEW string value.
;;
(defun ARCH:ATTUPDATE  (EN TAG NEW / EL)
  (setq EN (entnext EN)
        ;;skip INSERT
        EL (entget EN)
           ;;get ATTRIB
        )
  ;; Search attribs for match of tag name
  (while (and (= (cdr (assoc 0 EL)) "ATTRIB") (/= (cdr (assoc 2 EL)) TAG))
    (setq EN (entnext EN)
          ;;next ATTRIB
          EL (entget EN)))
  (if (= (cdr (assoc 0 EL)) "ATTRIB")
    (progn (entmod ;;modify entity data
                   (subst ;;substitute in list
                          (cons 1 NEW)
                          ;;new data
                          (assoc 1 EL)
                          ;;old data
                          EL
                          ;;list
                          ))
           (entupd EN)
           ;;force regen of entity
           )))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Area Calulation Table ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:SFT22  (/ lo ss)
  (setq lo (getvar "ctab"))
  (if (/= (getvar "ctab") "Model")(setvar "ctab" "Model"))
  (setvar "attreq" 0)
  (C:ONN)
  ;;(setq ss (ssget "_X" '((0 . "insert") (2 ."SHT_FloorAreaDRHorton"))))
  ;;(if ss (entdel (ssname ss 0)))
  (setq ss (ssget "X" '((2 . "SHT_FloorAreaDRHorton"))))
  (if (/= ss nil)(command "erase" ss ""))
  (if (/= ss nil)(command "-purge" "block" ss "no"))
  (ARCH:LYR "A-SYMB-CALC")
  (if (/= (ssget "A" '((0 . "HATCH") (8 . "AREA-HEAT-1ST"))) nil)
    (progn (setq ARCH#DECI "0")
           (if (/= (ssget "A" '((0 . "HATCH") (8 . "AREA-HEAT-1ST"))) nil)
             (SFT-TOTL-it)))
    (prompt "\n** No Area calculations for: Square Footage **"))
  (setvar "ctab" lo)
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun SFT-TOTL-it  (/ areasch en obj sfobj totur totac totsb note tmp totliv HEAT-1STsf HEAT-2NDsf GROS-1STsf GROS-2NDsf GARGsf PORCsf PATOsf) 
  (setvar "cmdecho" 0) 
  (command
           "-insert"
           (strcat "SHT_FloorAreaDRHorton" "=" ARCH#CUSF ARCH#_SYM  "Arch_syms\\"
                   "SHT_FloorAreaDRHorton")
           "ps"
           (getvar "dimscale")
           "0,0"
           1
           1
           0
           ""
           ""
           ""
           ""
           ""
           ""
           ""
           ""
           ""
           "")
;;; 
  (setq areasch (entlast))
  (setq en (cdr (assoc -1 (entget areasch))))
;;;
  (if (/= (ssget "A" '((0 . "HATCH") (8 . "AREA-HEAT-1ST"))) nil)
    (progn (setq HEAT-1ST
                  (cdr
                    (assoc -1
                           (entget (ssname (ssget "A" '((0 . "HATCH") (8 . "AREA-HEAT-1ST"))) 0)))))
           (command "AREA" "o" HEAT-1ST)         
           (setq HEAT-1STsf (/ (getvar "AREA") 144))
           (ARCH:ATTUPDATE en "HEAT-1ST" (strcat "" (rtos (/ (getvar "AREA") 144) 2 (atoi ARCH#DECI)) " SF"))))
  (if (/= (ssget "A" '((0 . "HATCH") (8 . "AREA-HEAT-2ND"))) nil)
    (progn (setq HEAT-2ND
                  (cdr
                    (assoc -1
                           (entget (ssname (ssget "A" '((0 . "HATCH") (8 . "AREA-HEAT-2ND"))) 0)))))
           (command "AREA" "o" HEAT-2ND)         
           (setq HEAT-2NDsf (/ (getvar "AREA") 144))
           (ARCH:ATTUPDATE en "HEAT-2ND" (strcat "" (rtos (/ (getvar "AREA") 144) 2 (atoi ARCH#DECI)) " SF"))))
  (if (/= (ssget "A" '((0 . "HATCH") (8 . "AREA-GROS-1ST"))) nil)
    (progn (setq GROS-1ST
                  (cdr
                    (assoc -1
                           (entget (ssname (ssget "A" '((0 . "HATCH") (8 . "AREA-GROS-1ST"))) 0)))))
           (command "AREA" "o" GROS-1ST)           
           (setq GROS-1STsf (/ (getvar "AREA") 144))
           (ARCH:ATTUPDATE en "GROS-1ST" (strcat "" (rtos (/ (getvar "AREA") 144) 2 (atoi ARCH#DECI)) " SF"))))
  (if (/= (ssget "A" '((0 . "HATCH") (8 . "AREA-GROS-2ND"))) nil)
    (progn (setq GROS-2ND
                  (cdr
                    (assoc -1
                           (entget (ssname (ssget "A" '((0 . "HATCH") (8 . "AREA-GROS-2ND"))) 0)))))
           (command "AREA" "o" GROS-2ND)         
           (setq GROS-2NDsf (/ (getvar "AREA") 144))
           (ARCH:ATTUPDATE en "GROS-2ND" (strcat "" (rtos (/ (getvar "AREA") 144) 2 (atoi ARCH#DECI)) " SF"))))
;;;
  (if (/= (ssget "A" '((0 . "HATCH") (8 . "AREA-BALC"))) nil)
    (progn (setq BALC
                  (cdr
                    (assoc -1
                           (entget (ssname (ssget "A" '((0 . "HATCH") (8 . "AREA-BALC"))) 0)))))
           (command "AREA" "o" BALC)           
           (setq BALCsf (/ (getvar "AREA") 144))
           (ARCH:ATTUPDATE en "BALC" (strcat "" (rtos (/ (getvar "AREA") 144) 2 (atoi ARCH#DECI)) " SF"))))
  (if (/= (ssget "A" '((0 . "HATCH") (8 . "AREA-GARG"))) nil)
    (progn (setq GARG
                  (cdr
                    (assoc -1
                           (entget (ssname (ssget "A" '((0 . "HATCH") (8 . "AREA-GARG"))) 0)))))
           (command "AREA" "o" GARG)           
           (setq GARGsf (/ (getvar "AREA") 144))
           (ARCH:ATTUPDATE en "GARG" (strcat "" (rtos (/ (getvar "AREA") 144) 2 (atoi ARCH#DECI)) " SF"))))
  (if (/= (ssget "A" '((0 . "HATCH") (8 . "AREA-PORC"))) nil)
    (progn (setq PORC
                  (cdr
                    (assoc -1
                           (entget (ssname (ssget "A" '((0 . "HATCH") (8 . "AREA-PORC"))) 0)))))
           (command "AREA" "o" PORC)         
           (setq PORCsf (/ (getvar "AREA") 144))
           (ARCH:ATTUPDATE en "PORC" (strcat "" (rtos (/ (getvar "AREA") 144) 2 (atoi ARCH#DECI)) " SF"))))
  (if (/= (ssget "A" '((0 . "HATCH") (8 . "AREA-PATO"))) nil)
    (progn (setq PATO
                  (cdr
                    (assoc -1
                           (entget (ssname (ssget "A" '((0 . "HATCH") (8 . "AREA-PATO"))) 0)))))
           (command "AREA" "o" PATO)         
           (setq PATOsf (/ (getvar "AREA") 144))
           (ARCH:ATTUPDATE en "PATO" (strcat "" (rtos (/ (getvar "AREA") 144) 2 (atoi ARCH#DECI)) " SF"))))
;;;
  (progn (if (= HEAT-1STsf nil)(setq HEAT-1STsf 0.0))
         (if (= HEAT-2NDsf nil)(setq HEAT-2NDsf 0.0))
         (if (= GROS-1STsf nil)(setq GROS-1STsf 0.0))
         (if (= GROS-2NDsf nil)(setq GROS-2NDsf 0.0))
         (if (= BALCsf nil)(setq BALCsf 0.0))
         (if (= GARGsf nil)(setq GARGsf 0.0))
         (if (= PORCsf nil)(setq PORCsf 0.0))
         (if (= PATOsf nil)(setq PATOsf 0.0)))
;;;
  (setq totur (strcat (rtos (+ GROS-1STsf GROS-2NDsf GARGsf PORCsf PATOsf) 2 (atoi ARCH#DECI)) " SF"))
  (setq totac (strcat (rtos (+ HEAT-1STsf HEAT-2NDsf) 2 (atoi ARCH#DECI)) " SF"))
  (setq totliv (strcat (rtos (+ GROS-1STsf GROS-2NDsf) 2 (atoi ARCH#DECI)) " SF"))
  (setq totsb (strcat (rtos (+ GROS-1STsf GARGsf PORCsf PATOsf) 2 (atoi ARCH#DECI)) " SF"))
;;;
  (if (/= totliv nil)(ARCH:ATTUPDATE en "TOTLIV" totliv))
  (if (/= totur nil)(ARCH:ATTUPDATE en "TOTUR" totur))
  (if (/= totac nil)(ARCH:ATTUPDATE en "TOTAC" totac))
  (if (/= totsb nil)(ARCH:ATTUPDATE en "TOTSB" totsb))
;;;
  (command "copy" areasch "" '(0.0 0.0 0.0) '(1632.0 0.0 0.0))
  (princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: vl-string-left-trim
« Reply #29 on: December 16, 2019, 11:00:06 AM »
Here is another one that will make you slap your forehead, see attached file for setting up dimstyles.
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64