Leaderboard

Believe it or not but I am Kenny Ramage. I cannot believe that AfraLisp is still having an influence.

Kenny Ramage here. (AfraLisp) Semi retired now but would like to help out especially with the basics.

Welcome to CADTutor Kenny!! I still refer to AfraLisp from time to time to brush up on things.

Hi, Your codes you posted into your last post did not work because you have one missing close bracket that should close the line of codes related to the variable blockss. This would list and print all found hatch patterns in current space : (defun c:Test (/ int sel ent lst pat) ;;----------------------------------------------------;; ;; Tharwat - Date : Jun.15.2020 ;; ;; website: https://autolispprograms.wordpress.com ;; ;; List all used Hatch patterns in current space. ;; ;;----------------------------------------------------;; (and (or (setq int -1 sel (ssget "_X" (list '(0 . "HATCH") (cons 410 (getvar 'CTAB))))) (alert "No hatch objects found in current space !") ) (while (setq int (1+ int) ent (ssname sel int) ) (or (member (setq pat (cdr (assoc 2 (entget ent)))) lst) (setq lst (cons pat lst)) ) ) (or (textscr) t) (princ "\nHatch Patterns found : ") (foreach itm lst (princ (strcat "\n" itm)) ) ) (princ) )

I knew I recognized that name somewhere! Afralisp has been a life saver. Genuine legend for setting that up initially.

This thread was started in 2015, since then, AutoCAD comes with AutoCAD Architecture now as a Toolset.

I dont do it use child dcl but if temporary close a dcl the main thing would be to save all the relevant variable values, so when reopen can set them back again. You can call defuns as part of a "action tile" so would have all the get action tiles in a defun much easier to work out what is going on.

Thanks for helping so many of us get started!

Sorry I misunderstood. rather then building an entget list and using entmod. I just used vla-put to update layer if existing. entmakex if not existing. ;; Creates a new layer or updates an existing one if it exists. ;; Will attempt to load the linetype if found in the acad*.lin file and if the layer exists, it will update the properties. ;; Code by ronjonp, taken from: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/create-layer-with-true-color-in-lisp/m-p/7904814#M367339 ;; Usage: ;; (_addOrUpdateLayer "NewLayerName" '(69 69 69) "3Dash2" 1 "Description goes here") ;; (_addOrUpdateLayer "NewLayerName2" 169 "3Dash2" 0 "Description goes here") ;; NOTE: ;; The 0 or 1 in examples above is for plot on = 1 or plot off = 0. ;; Modified by 3dwannab on 2022.06.11 to add description to the function. (defun _addOrUpdateLayer (name color ltype plot desc / _loadlinetype _rgb _setLayDescription d e) ;; RJP - 04.03.2018 ;; Creates or updates a layer (defun _rgb (l) (+ (lsh (fix (car l)) 16) (lsh (fix (cadr l)) 8) (fix (caddr l)))) (defun _loadlinetype (linetype / lt out) (cond ((tblobjname "ltype" linetype) t) ((setq lt (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object)))) (setq out (vl-catch-all-apply 'vla-load (list lt linetype (findfile (if (= 0 (getvar 'measurement)) "acad.lin" "acadiso.lin" ) ) ) ) ) (not (vl-catch-all-error-p out)) ) ) ) (if (tblsearch "layer" name) (progn (setq layerobj (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) name)) (vla-put-Color layerobj color) (vla-put-linetype layerobj (if (_loadlinetype ltype) ltype "continuous")) (cond ((eq plot 0) (vla-put-plottable layerobj :vlax-false) ) ((eq plot 1) (vla-put-plottable layerobj :vlax-true) ) ) (vla-put-description layerobj desc) ) (entmakex (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(70 . 0) (cons 2 name) (if (listp color) (cons 420 (_rgb color)) (cons 62 color) ) (cons 6 (if (tblsearch "ltype" ltype) ltype "continuous" ) ) (cons 290 plot) ;;1 = plottable 0 = not=plottable ) ) ) ) maybe @ronjonp can explain/fix the entmod.

Here is an example for you to move forward which should help you to know who it works. (setq ip1 (list 0.0 0.0) ip2 (list 0.0 1.0) ) (repeat 3 ;; repeat 3 times (command "-MTEXT" "_non" ip1 "H" "1.6" "_non" ip2 "Handbrandsläckare" "") (setq ip1 (list (+ (car ip1) 25.0) (cadr ip1)) ;; add 25.0 units to X coordinates ip2 (list (+ (car ip2) 25.0) (cadr ip2)) ;; add 25.0 units to X coordinates ) )